From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from localhost (localhost [127.0.0.1]) by olra.theworths.org (Postfix) with ESMTP id 29DD2431FAE for ; Thu, 19 Jan 2012 13:22:42 -0800 (PST) X-Virus-Scanned: Debian amavisd-new at olra.theworths.org X-Spam-Flag: NO X-Spam-Score: 0.201 X-Spam-Level: X-Spam-Status: No, score=0.201 tagged_above=-999 required=5 tests=[DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, FREEMAIL_ENVFROM_END_DIGIT=1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled Received: from olra.theworths.org ([127.0.0.1]) by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id 092KA9m-pB5d for ; Thu, 19 Jan 2012 13:22:39 -0800 (PST) Received: from mail-ww0-f45.google.com (mail-ww0-f45.google.com [74.125.82.45]) (using TLSv1 with cipher RC4-SHA (128/128 bits)) (No client certificate requested) by olra.theworths.org (Postfix) with ESMTPS id A7725431FB6 for ; Thu, 19 Jan 2012 13:22:37 -0800 (PST) Received: by wgbdt12 with SMTP id dt12so400608wgb.2 for ; Thu, 19 Jan 2012 13:22:36 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=gamma; h=from:to:cc:subject:date:message-id:x-mailer:in-reply-to:references; bh=jpMQQrJWRh6ucDHFQC2wfBL7Dm+6z/19GhiWGfz9aL4=; b=e6WXSXqJ+oMNnQR77xi0HLsjcsBSon5xibhE0Kfp2z1Ac9bmY6j8df6XHJ8e3aH3qn SJiczhQo9Ac5kHUG0n3rmYvlw+dxCEuyLYbWndddyXev4GXo6IijyRlTQSH1LX1BGIMY K+qEW985xCT74i10xf582X2pV2F+RQ3MVw/DU= Received: by 10.180.100.100 with SMTP id ex4mr19447700wib.19.1327008156503; Thu, 19 Jan 2012 13:22:36 -0800 (PST) Received: from localhost (94-192-233-223.zone6.bethere.co.uk. [94.192.233.223]) by mx.google.com with ESMTPS id dr5sm2051181wib.0.2012.01.19.13.22.34 (version=TLSv1/SSLv3 cipher=OTHER); Thu, 19 Jan 2012 13:22:35 -0800 (PST) From: Mark Walters To: notmuch@notmuchmail.org Subject: [PATCH v4 1/1] Make buttons for attachments allow viewing as well as saving Date: Thu, 19 Jan 2012 21:23:05 +0000 Message-Id: <1327008185-21194-2-git-send-email-markwalters1009@gmail.com> X-Mailer: git-send-email 1.7.2.3 In-Reply-To: References: X-BeenThere: notmuch@notmuchmail.org X-Mailman-Version: 2.1.13 Precedence: list List-Id: "Use and development of the notmuch mail system." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 19 Jan 2012 21:22:42 -0000 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 | 116 ++++++++++++++++++++++++++++++++++++++---------- 1 files changed, 92 insertions(+), 24 deletions(-) diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index fc13462..1fcd72a 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -112,6 +112,16 @@ indentation." :type 'boolean :group 'notmuch-show) +(defcustom notmuch-show-part-button-default-action 'notmuch-show-save-part + "Default part header button action (on ENTER or mouse click)." + :group 'notmuch-show + :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))) + (defmacro with-current-notmuch-show-message (&rest body) "Evaluate body with current buffer set to the text of current message" `(save-excursion @@ -283,10 +293,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 @@ -301,29 +322,58 @@ 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)) + ,@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)) + ;; We override mm-save-part as notmuch-show-save-part is better + ;; since it offers the filename. We need to lexically bind + ;; everything we need for notmuch-show-save-part to prevent + ;; potential dynamic shadowing. + (lexical-let ((message-id message-id) + (nth nth) + (filename filename) + (content-type content-type)) + (flet ((mm-save-part (&rest args) (notmuch-show-save-part + message-id nth filename content-type))) + (mm-display-part handle)))))) + +(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 @@ -1504,12 +1554,30 @@ 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?).")))) +(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)) + +(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))))))) ;; -- 1.7.2.3