[PATCH v2] Make buttons for attachments allow viewing as well as saving

[PATCH v2] Make buttons for attachments allow viewing as well as saving

[Mark Walters]

Define a keymap for attachment buttons to allow multiple actions.
Define 3 possible actions:
    save attachment: exactly as currently,
    view attachment: uses mailcap entry,
    view attachment with user chosen program

Keymap on a button is: s for save, v for view and o for view with
other program. Default (i.e. enter or mouse button) is save but this
is configurable in notmuch customize.

One implementation detail: the view attachment function forces all
attachments to be "displayed" using mailcap even if emacs could
display them itself. Thus, for example, text/html appears in a browser
and text/plain asks whether to save (on a standard debian setup)
---
 emacs/notmuch-show.el |   89 +++++++++++++++++++++++++++++++++++++++---------
 1 files changed, 72 insertions(+), 17 deletions(-)

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 03c1f6b..6935525 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -281,10 +281,21 @@ message at DEPTH in the current thread."
 	(run-hooks 'notmuch-show-markup-headers-hook)))))
 
 (define-button-type 'notmuch-show-part-button-type
-  'action 'notmuch-show-part-button-action
+  'action 'notmuch-show-part-button-default
+  'keymap 'notmuch-show-part-button-map
   'follow-link t
   'face 'message-mml)
 
+(defvar notmuch-show-part-button-map
+  (let ((map (make-sparse-keymap)))
+       (set-keymap-parent map button-map)
+       (define-key map "s" 'notmuch-show-part-button-save)
+       (define-key map "v" 'notmuch-show-part-button-view)
+       (define-key map "o" 'notmuch-show-part-button-interactively-view)
+    map)
+  "Submap for button commands")
+(fset 'notmuch-show-part-button-map notmuch-show-part-button-map)
+
 (defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment)
   (let ((button))
     (setq button
@@ -299,29 +310,43 @@ message at DEPTH in the current thread."
 		   " ]")
 	   :type 'notmuch-show-part-button-type
 	   :notmuch-part nth
-	   :notmuch-filename name))
+	   :notmuch-filename name
+	   :notmuch-content-type content-type))
     (insert "\n")
     ;; return button
     button))
 
 ;; Functions handling particular MIME parts.
 
+;; this function is kept for the tests and any external users
 (defun notmuch-show-save-part (message-id nth &optional filename)
+  (notmuch-show-part-action 'notmuch-show-part-save-action message-id nth nil filename))
+
+(defun notmuch-show-part-action (action message-id nth content-type &optional filename)
   (let ((process-crypto notmuch-show-process-crypto))
     (with-temp-buffer
       (setq notmuch-show-process-crypto process-crypto)
       ;; Always acquires the part via `notmuch part', even if it is
       ;; available in the JSON output.
       (insert (notmuch-show-get-bodypart-internal message-id nth))
-      (let ((file (read-file-name
-		   "Filename to save as: "
-		   (or mailcap-download-directory "~/")
-		   nil nil
-		   filename)))
-	;; Don't re-compress .gz & al.  Arguably we should make
-	;; `file-name-handler-alist' nil, but that would chop
-	;; ange-ftp, which is reasonable to use here.
-	(mm-write-region (point-min) (point-max) file nil nil nil 'no-conversion t)))))
+      (cond ((eq action 'notmuch-show-part-save-action)
+	     (let ((file (read-file-name
+			  "Filename to save as: "
+			  (or mailcap-download-directory "~/")
+			  nil nil
+			  filename)))
+	       ;; Don't re-compress .gz & al.  Arguably we should make
+	       ;; `file-name-handler-alist' nil, but that would chop
+	       ;; ange-ftp, which is reasonable to use here.
+	       (mm-write-region (point-min) (point-max) file nil nil nil 'no-conversion t)))
+	    ((eq action 'notmuch-show-part-view-action)
+	     ;; set mm-inlined-types to nil to force an external viewer
+	     (let ((handle (mm-make-handle (current-buffer) (list content-type)))
+		   (mm-inlined-types nil))
+	       (mm-display-part handle)))
+	    ((eq action 'notmuch-show-part-interactively-view-action)
+	     (let ((handle (mm-make-handle (current-buffer) (list content-type))))
+	       (mm-interactively-view-part handle)))))))
 
 (defun notmuch-show-mm-display-part-inline (msg part nth content-type)
   "Use the mm-decode/mm-view functions to display a part in the
@@ -1502,12 +1527,42 @@ buffer."
 
 ;; Commands typically bound to buttons.
 
-(defun notmuch-show-part-button-action (button)
-  (let ((nth (button-get button :notmuch-part)))
-    (if nth
-	(notmuch-show-save-part (notmuch-show-get-message-id) nth
-				(button-get button :notmuch-filename))
-      (message "Not a valid part (is it a fake part?)."))))
+(defcustom notmuch-show-part-button-default-action 'notmuch-show-part-save-action
+  "Default part header button action (on ENTER or mouse click)."
+  :group 'notmuch
+  :type '(choice (const :tag "Save part"
+			notmuch-show-part-save-action)
+		 (const :tag "View part"
+			notmuch-show-part-view-action)
+		 (const :tag "View interactively"
+			notmuch-show-part-interactively-view-action)))
+
+(defun notmuch-show-part-button-default (&optional button)
+  (interactive)
+  (notmuch-show-part-button notmuch-show-part-button-default-action button))
+
+(defun notmuch-show-part-button-save (&optional button)
+  (interactive)
+  (notmuch-show-part-button 'notmuch-show-part-save-action button))
+
+(defun notmuch-show-part-button-view (&optional button)
+  (interactive)
+  (notmuch-show-part-button 'notmuch-show-part-view-action button))
+
+(defun notmuch-show-part-button-interactively-view (&optional button)
+  (interactive)
+  (notmuch-show-part-button 'notmuch-show-part-interactively-view-action button))
+
+(defun notmuch-show-part-button (action &optional button)
+  (interactive)
+  (let ((button (or button (button-at (point)))))
+    (if button
+      (let ((nth (button-get button :notmuch-part)))
+	(if nth
+	    (notmuch-show-part-action action (notmuch-show-get-message-id) nth
+				    (button-get button :notmuch-content-type)
+				    (button-get button :notmuch-filename))
+	  (message "Not a valid part (is it a fake part?)."))))))
 
 ;;
 
-- 
1.7.2.3

Re: [PATCH v2] Make buttons for attachments allow viewing as well as saving

[Jameson Graef Rollins]

[-- Attachment #1: Type: text/plain, Size: 449 bytes --]

On Mon, 16 Jan 2012 21:38:30 +0000, Mark Walters <markwalters1009@gmail.com> wrote:
> Define a keymap for attachment buttons to allow multiple actions.

Thanks, Mark.  This new patch works great.  I'm still not quite sure why
it wasn't working for me before, but this patch works great.

+1

We'll need to add a ":group notmuch-show" if Pieter's defcustom
groupings patch does in first, but that's minor.

Thanks for the nice functionality!

jamie.

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]