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

[Austin Clements]

Quoth Mark Walters on Jan 17 at  8:39 pm:
> > > I am happy to make that change. My original patch in the summer was more
> > > like that:
> > > id:"CALUdzSWAto+4mCUOOMk+8vFs+Pog-xUma6u-Aqx2M6-sbyQROg at mail.gmail.com"
> > 
> > Is this the right id?  I couldn't find it in the list archive.
> 
> Sorry I messed up: it should be id:"87mxehqhbl.fsf at r102.config" However
> I have included my current draft along these lines. I think it is
> working but I am not submitting yet: just asking if this is the right
> idea.

In general, yes, I think so.  A few comments on your draft below.

> Best wishes 
> 
> Mark
> 
> From 9e52414b9871369c1cbb5c3e72d833b56bb236d4 Mon Sep 17 00:00:00 2001
> From: Mark Walters <markwalters1009 at gmail.com>
> Date: Sat, 14 Jan 2012 18:04:22 +0000
> Subject: [PATCH] Make buttons for attachments allow viewing as well as saving
> 
> 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 |   87 ++++++++++++++++++++++++++++++++++++++++++++----
>  1 files changed, 79 insertions(+), 8 deletions(-)
> 
> diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
> index 03c1f6b..2413caa 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)

I don't think this fset is necessary.  Actually, I've never seen this
outside of the notmuch code.  It looks like it does appear in code
shipped with Emacs, but only in a handful of places.  All of those
places look like very old code, so maybe this was necessary once upon
a time?

> +
>  (defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment)
>    (let ((button))
>      (setq button
> @@ -299,7 +310,8 @@ 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))
> @@ -323,6 +335,28 @@ message at DEPTH in the current thread."
>  	;; ange-ftp, which is reasonable to use here.
>  	(mm-write-region (point-min) (point-max) file nil nil nil 'no-conversion t)))))
>  
> +(defun notmuch-show-view-part (message-id nth content-type)
> +  (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))
> +      ;; 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 t)))))
> +
> +(defun notmuch-show-interactively-view-part (message-id nth content-type)
> +  (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 ((handle (mm-make-handle (current-buffer) (list content-type))))
> +	(mm-interactively-view-part handle)))))
> +

Yeah.  Though you're right that the duplication is a little annoying.
With the snippet I sent earlier, these could change to, e.g.,

(defun notmuch-show-interactively-view-part (message-id nth content-type)
  (notmuch-with-part-temp-buffer
   message-id nth
   (lambda ()
     (let ((handle (mm-make-handle (current-buffer) (list content-type))))
       (mm-interactively-view-part handle)))))

Maybe this is better as a macro...

(defmacro notmuch-with-temp-part-buffer (message-id nth &rest body)
  (declare (indent 2))
  (let ((process-crypto (make-symbol "process-crypto")))
    `(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))
         , at body))))

(defun notmuch-show-interactively-view-part (message-id nth content-type)
  (notmuch-with-temp-part-buffer message-id nth
    (let ((handle (mm-make-handle (current-buffer) (list content-type))))
      (mm-interactively-view-part handle)))))

Up to you.  Maybe there's no really satisfying way to write this.

>  (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
>  current buffer, if possible."
> @@ -1502,12 +1536,49 @@ 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-button-save
> +  "Default part header button action (on ENTER or mouse click)."
> +  :group 'notmuch
> +  :type '(choice (const :tag "Save part"
> +			notmuch-show-part-button-save)
> +		 (const :tag "View part"
> +			notmuch-show-part-button-view)
> +		 (const :tag "View interactively"
> +			notmuch-show-part-button-interactively-view)))

You probably want this to be the handler function, rather than the
button function, since the interface to the button function is rather
awkward.  That is, if someone wanted to plug in their own action, they
would want to define it in terms of the high-level handler interface
that you use above, rather than the low-level
button-with-magic-properties interface that Emacs forces you to use
below.

> +
> +(defun notmuch-show-part-button-default (&optional button)
> +  (interactive)
> +  (funcall notmuch-show-part-button-default-action button))
> +
> +(defun notmuch-show-part-button-save (&optional button)
> +  (interactive)
> +  (let ((button (or button (button-at (point)))))
> +    (if 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?)."))))))
> +
> +(defun notmuch-show-part-button-view (&optional button)
> +  (interactive)
> +  (let ((button (or button (button-at (point)))))
> +    (if button
> +	(let ((nth (button-get button :notmuch-part)))
> +	  (if nth
> +	      (notmuch-show-view-part (notmuch-show-get-message-id) nth
> +				      (button-get button :notmuch-content-type))
> +	    (message "Not a valid part (is it a fake part?)."))))))
> +
> +(defun notmuch-show-part-button-interactively-view (&optional button)
> +  (interactive)
> +  (let ((button (or button (button-at (point)))))
> +    (if button
> +	(let ((nth (button-get button :notmuch-part)))
> +	  (if nth
> +	      (notmuch-show-interactively-view-part (notmuch-show-get-message-id) nth
> +						    (button-get button :notmuch-content-type))
> +	    (message "Not a valid part (is it a fake part?)."))))))

This duplication is much worse, but also less necessary.

(defun notmuch-show-part-button-interactively-view (&optional button)
  (interactive)
  (notmuch-show-part-button-internal button #'notmuch-show-interactively-view-part))

(defun notmuch-show-part-button-internal (button handler)
  (let ((button (or button (button-at (point)))))
    (if button
	(let ((nth (button-get button :notmuch-part)))
	  (if nth
	      (funcall handler (notmuch-show-get-message-id) nth
			       (button-get button :notmuch-content-type))
	    (message "Not a valid part (is it a fake part?)."))))))