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

[Austin Clements]

Quoth Mark Walters on Jan 17 at 10:27 pm:
> > (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))))
> 
> I have followed the macro approach: since notmuch-show-save-part also
> uses it (which doesn't appear in the diff as it was unchanged). I have
> made all three functions use notmuch-with-temp-part-buffer. However, I
> used the macro exactly as you wrote it (and it seems to work) but I
> moderately understand why but could not justify it to someone! 

Oops, actually there was a bug in that macro.  It should have been

(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))))

The only difference is on the "insert" line.  Sorry about that.

I don't know how familiar you are with syntactic abstraction, so
here's a top-down explanation.  A macro is like the compile-time
equivalent of a function: rather than the arguments and return being
values that result from evaluation, they are pieces of code, the body
of the macro executes at compile time instead of at run time, and the
compiler replaces the invocation of the macro with the code that the
macro returns.  This is not unlike a C/C++ macro, but the
implementation of the macro is regular Lisp code that runs at compile
time and the code is represented as S-expressions rather than strings
(one beauty of Lisp is that the representation of code and data is the
same).

The above macro returns the code starting after the "`" (pronounced
quasiquote), so that's what invocations of the macro get replaced
with.  Quasiquote (like quote) inhibits the evaluation of what follows
it and results in the code as data, rather than the result of
evaluating the code.  Unlike quote, quasiquote lets you jump back into
the evaluator using "," and ",@", so it's great for piecing together
code from a template, which is what macros spend most of their time
doing.

The "declare" is simply a specification to emacs-lisp-mode about how
to indent uses of this macro.  The "make-symbol" is necessary to avoid
conflicting with variable names that may appear in the code that uses
this macro (since the invoking code and the code returned by the macro
will be interleaved, you have to worry about variable conflicts).

> > (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)))))
> 
> Emacs wants to indent the (let line level with message-id in the line
> above which looks odd (and makes the lines too long). Do I overrule
> emacs, or put message-id and nth onto a separate line or is there
> something better?

If you evaluate the defmacro, it'll pick up on that declare line at
the beginning of it and indent this correctly.

> Also note that, because of the unification with notmuch-show-save-part
> all three functions have to have the four arguments message-id, nth,
> filename and content-type (even though currently each individual
> function only uses three of them). However see below for another comment
> on this.

That makes sense.

> > > +(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.
> 
> I have done this.
> 
> > 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?)."))))))
> 
> Yes this is much nicer and I have done this too (modulo the extra
> argument mentioned above).
> 
> Finally, I have discovered one bug/misfeature. If you try to "view" an
> attachment then it will offer to save it but will not offer a
> filename. If you try and save it (or use the default action) it will
> offer a filename as now. As far as I can see this is not fixable if I
> use mm-display-part: however, I could include a slight tweaked version,
> notmuch-show-mm-display-part say, which would fix this corner
> case. (Essentially, it would call notmuch-show-save-part if it failed to
> find a handler rather than mailcap-save-binary-file.) However, this is
> about 50 lines of lisp so I am not sure it is worth it.

Hmm.  This is probably worth fixing, but probably in a separate patch.
Duplicating mm-display-part is probably not the way to go.  It think
it will work to pass t as the no-default argument to mm-display-part
and check the return value, which should be 'inline if it was able to
handle it internally or 'external if it found an external helper.  I'm
pretty sure it will never fall in to mailcap-save-binary-file in that
case.  If that doesn't work, you could flet mailcap-save-binary-file
around the call to mm-display-part.

> Best wishes
> 
> Mark
> 
> From bda4bb7637fb7d09c50f95b6b76fd42a377e0dde 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 |  105 +++++++++++++++++++++++++++++++++++++-----------
>  1 files changed, 81 insertions(+), 24 deletions(-)
> 
> diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
> index 03c1f6b..2e4fecd 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,48 @@ 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.
>  
> -(defun notmuch-show-save-part (message-id nth &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)))))
> +(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))

Should be ",message-id ,nth" instead of "message-id nth" (my fault).

> +	 , at body))))
> +
> +(defun notmuch-show-save-part (message-id nth &optional filename content-type)
> +  (notmuch-with-temp-part-buffer 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))))
> +
> +(defun notmuch-show-view-part (message-id nth &optional filename content-type )
> +  (notmuch-with-temp-part-buffer 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 &optional filename 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))))
>  
>  (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,13 +1532,40 @@ 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-save-part
> +  "Default part header button action (on ENTER or mouse click)."
> +  :group 'notmuch
> +  :type '(choice (const :tag "Save part"
> +			notmuch-show-save-part)
> +		 (const :tag "View part"
> +			notmuch-show-view-part)
> +		 (const :tag "View interactively"
> +			notmuch-show-interactively-view-part)))
> +
> +(defun notmuch-show-part-button-default (&optional button)
> +  (interactive)
> +  (notmuch-show-part-button-internal button notmuch-show-part-button-default-action))
>  
> +(defun notmuch-show-part-button-save (&optional button)
> +  (interactive)
> +  (notmuch-show-part-button-internal button #'notmuch-show-save-part))
> +
> +(defun notmuch-show-part-button-view (&optional button)
> +  (interactive)
> +  (notmuch-show-part-button-internal button #'notmuch-show-view-part))
> +
> +(defun notmuch-show-part-button-interactively-view (&optional button)
> +  (interactive)
> +  (notmuch-show-part-button-internal button #'notmuch-show-interactively-view-part))

Much better!

> +
> +(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-filename)
> +		       (button-get button :notmuch-content-type)))))))
>  ;;
>  
>  (provide 'notmuch-show)