--- /dev/null
+Return-Path: <amdragon@mit.edu>\r
+X-Original-To: notmuch@notmuchmail.org\r
+Delivered-To: notmuch@notmuchmail.org\r
+Received: from localhost (localhost [127.0.0.1])\r
+ by olra.theworths.org (Postfix) with ESMTP id 19452431FAE\r
+ for <notmuch@notmuchmail.org>; Mon, 27 May 2013 13:47:06 -0700 (PDT)\r
+X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
+X-Spam-Flag: NO\r
+X-Spam-Score: -0.7\r
+X-Spam-Level: \r
+X-Spam-Status: No, score=-0.7 tagged_above=-999 required=5\r
+ tests=[RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled\r
+Received: from olra.theworths.org ([127.0.0.1])\r
+ by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
+ with ESMTP id 7R8hPPbCv6rg for <notmuch@notmuchmail.org>;\r
+ Mon, 27 May 2013 13:47:00 -0700 (PDT)\r
+Received: from dmz-mailsec-scanner-5.mit.edu (DMZ-MAILSEC-SCANNER-5.MIT.EDU\r
+ [18.7.68.34])\r
+ by olra.theworths.org (Postfix) with ESMTP id 272B5431FC0\r
+ for <notmuch@notmuchmail.org>; Mon, 27 May 2013 13:46:54 -0700 (PDT)\r
+X-AuditID: 12074422-b7f5b6d00000095d-9c-51a3c63d5e40\r
+Received: from mailhub-auth-3.mit.edu ( [18.9.21.43])\r
+ by dmz-mailsec-scanner-5.mit.edu (Symantec Messaging Gateway) with SMTP\r
+ id 83.3B.02397.D36C3A15; Mon, 27 May 2013 16:46:53 -0400 (EDT)\r
+Received: from outgoing.mit.edu (OUTGOING-AUTH-1.MIT.EDU [18.9.28.11])\r
+ by mailhub-auth-3.mit.edu (8.13.8/8.9.2) with ESMTP id r4RKkgLn032252; \r
+ Mon, 27 May 2013 16:46:43 -0400\r
+Received: from drake.dyndns.org (c-76-21-105-205.hsd1.ca.comcast.net\r
+ [76.21.105.205]) (authenticated bits=0)\r
+ (User authenticated as amdragon@ATHENA.MIT.EDU)\r
+ by outgoing.mit.edu (8.13.8/8.12.4) with ESMTP id r4RKke5W026423\r
+ (version=TLSv1/SSLv3 cipher=AES256-SHA bits=256 verify=NOT);\r
+ Mon, 27 May 2013 16:46:42 -0400\r
+Received: from amthrax by drake.dyndns.org with local (Exim 4.77)\r
+ (envelope-from <amdragon@mit.edu>)\r
+ id 1Uh4JT-0008NF-Tl; Mon, 27 May 2013 16:46:39 -0400\r
+From: Austin Clements <amdragon@MIT.EDU>\r
+To: notmuch@notmuchmail.org\r
+Subject: [PATCH 3/4] emacs: Simplify MIME part command implementation\r
+Date: Mon, 27 May 2013 16:46:33 -0400\r
+Message-Id: <1369687594-31774-4-git-send-email-amdragon@mit.edu>\r
+X-Mailer: git-send-email 1.7.10.4\r
+In-Reply-To: <1369687594-31774-1-git-send-email-amdragon@mit.edu>\r
+References: <1369687594-31774-1-git-send-email-amdragon@mit.edu>\r
+X-Brightmail-Tracker:\r
+ H4sIAAAAAAAAA+NgFjrBIsWRmVeSWpSXmKPExsUixCmqrWt7bHGgwZtV5har5/JYXL85k9mB\r
+ yWPnrLvsHs9W3WIOYIrisklJzcksSy3St0vgyli1YxpjwQm/ip7dF9gaGPc5djFyckgImEi8\r
+ WPiYDcIWk7hwbz2QzcUhJLCPUeLX/OtMEM5GRom1u7dCOaeZJHasWcQE0iIkMJdRYle7JojN\r
+ JqAhsW3/ckYQW0RAWmLn3dmsIDazgKPE5/2LwFYIC7hKvN19hQXEZhFQlbgw6zA7iM0r4CDx\r
+ 8V8fO8QZihLdzyaA1XMC9V7Z9ZsVYpeDxOrXHUwTGPkXMDKsYpRNya3SzU3MzClOTdYtTk7M\r
+ y0st0jXVy80s0UtNKd3ECAokdhelHYw/DyodYhTgYFTi4bXIXBwoxJpYVlyZe4hRkoNJSZSX\r
+ /QhQiC8pP6UyI7E4I76oNCe1+BCjBAezkgjv9hVAOd6UxMqq1KJ8mJQ0B4uSOO+1lJv+QgLp\r
+ iSWp2ampBalFMFkZDg4lCd6mo0CNgkWp6akVaZk5JQhpJg5OkOE8QMPDQGp4iwsSc4sz0yHy\r
+ pxh1OTafn/yOUYglLz8vVUqcNwWkSACkKKM0D24OLAG8YhQHekuYNx+kigeYPOAmvQJawgS0\r
+ RJwZbElJIkJKqoHR4RHDTpVj+W4nzTWjvl4Tb1nG7yH2bKaq0p6muZGXt117WC8+59ubFy9V\r
+ eV/oPtlQstcwXGhjxa5tsw6Y5Pw/WeD5NSneId9CsP7f2ZoN1hx+Fls1hK6VBV5cfUO6pLXr\r
+ 8+XLjiK/nevdbVrnpP5/+cO4+/X1N1Klp6ReTPvwT40jOOgw14QcJZbijERDLeai4kQAlV7j\r
+ dNsCAAA=\r
+X-BeenThere: notmuch@notmuchmail.org\r
+X-Mailman-Version: 2.1.13\r
+Precedence: list\r
+List-Id: "Use and development of the notmuch mail system."\r
+ <notmuch.notmuchmail.org>\r
+List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
+List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
+List-Post: <mailto:notmuch@notmuchmail.org>\r
+List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
+List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
+X-List-Received-Date: Mon, 27 May 2013 20:47:06 -0000\r
+\r
+This unifies the part button actions and the underlying part action\r
+functions into single interactive command that simply applies to the\r
+part containing point using the just-added part p-list text property\r
+instead of button properties. Since all part actions can be performed\r
+by applying the appropriate mm function to an mm-handle, this patch\r
+abstracts out the creation of mm handles, making the implementations\r
+of the part commands trivial. This also eliminates our special\r
+handling for part save in favor of using the appropriate mm function.\r
+\r
+This necessarily modifies the way we handle the default part button\r
+action, but in a way that does not change the meaning of the\r
+notmuch-show-part-button-default-action defcustom.\r
+\r
+Since these commands are no longer specific to buttons, this patch\r
+eliminates the extra metadata stored with each button. This also\r
+eliminates one rather special-purpose macro for a collection of\r
+general purpose part handling utilities.\r
+---\r
+ emacs/notmuch-show.el | 133 +++++++++++++++++++++----------------------------\r
+ test/emacs | 4 +-\r
+ 2 files changed, 61 insertions(+), 76 deletions(-)\r
+\r
+diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
+index acd0b55..b33d92d 100644\r
+--- a/emacs/notmuch-show.el\r
++++ b/emacs/notmuch-show.el\r
+@@ -474,10 +474,10 @@ message at DEPTH in the current thread."\r
+ (defvar notmuch-show-part-button-map\r
+ (let ((map (make-sparse-keymap)))\r
+ (set-keymap-parent map button-map)\r
+- (define-key map "s" 'notmuch-show-part-button-save)\r
+- (define-key map "v" 'notmuch-show-part-button-view)\r
+- (define-key map "o" 'notmuch-show-part-button-interactively-view)\r
+- (define-key map "|" 'notmuch-show-part-button-pipe)\r
++ (define-key map "s" 'notmuch-show-save-part)\r
++ (define-key map "v" 'notmuch-show-view-part)\r
++ (define-key map "o" 'notmuch-show-interactively-view-part)\r
++ (define-key map "|" 'notmuch-show-pipe-part)\r
+ map)\r
+ "Submap for button commands")\r
+ (fset 'notmuch-show-part-button-map notmuch-show-part-button-map)\r
+@@ -494,61 +494,11 @@ message at DEPTH in the current thread."\r
+ (insert-button\r
+ (concat "[ " base-label " ]")\r
+ :base-label base-label\r
+- :type 'notmuch-show-part-button-type\r
+- :notmuch-part nth\r
+- :notmuch-filename name\r
+- :notmuch-content-type content-type))\r
++ :type 'notmuch-show-part-button-type))\r
+ (insert "\n")\r
+ ;; return button\r
+ button))\r
+ \r
+-;; Functions handling particular MIME parts.\r
+-\r
+-(defmacro notmuch-with-temp-part-buffer (message-id nth &rest body)\r
+- (declare (indent 2))\r
+- (let ((process-crypto (make-symbol "process-crypto")))\r
+- `(let ((,process-crypto notmuch-show-process-crypto))\r
+- (with-temp-buffer\r
+- (setq notmuch-show-process-crypto ,process-crypto)\r
+- ;; Always acquires the part via `notmuch part', even if it is\r
+- ;; available in the JSON output.\r
+- (insert (notmuch-get-bodypart-internal ,message-id ,nth notmuch-show-process-crypto))\r
+- ,@body))))\r
+-\r
+-(defun notmuch-show-save-part (message-id nth &optional filename content-type)\r
+- (notmuch-with-temp-part-buffer message-id nth\r
+- (let ((file (read-file-name\r
+- "Filename to save as: "\r
+- (or mailcap-download-directory "~/")\r
+- nil nil\r
+- filename)))\r
+- ;; Don't re-compress .gz & al. Arguably we should make\r
+- ;; `file-name-handler-alist' nil, but that would chop\r
+- ;; ange-ftp, which is reasonable to use here.\r
+- (mm-write-region (point-min) (point-max) file nil nil nil 'no-conversion t))))\r
+-\r
+-(defun notmuch-show-view-part (message-id nth &optional filename content-type )\r
+- (notmuch-with-temp-part-buffer message-id nth\r
+- (let* ((disposition (if filename `(attachment (filename . ,filename))))\r
+- (handle (mm-make-handle (current-buffer) (list content-type)\r
+- nil nil disposition))\r
+- ;; Set the default save directory to be consistent with\r
+- ;; `notmuch-show-save-part'.\r
+- (mm-default-directory (or mailcap-download-directory "~/"))\r
+- ;; set mm-inlined-types to nil to force an external viewer\r
+- (mm-inlined-types nil))\r
+- (mm-display-part handle))))\r
+-\r
+-(defun notmuch-show-interactively-view-part (message-id nth &optional filename content-type)\r
+- (notmuch-with-temp-part-buffer message-id nth\r
+- (let ((handle (mm-make-handle (current-buffer) (list content-type))))\r
+- (mm-interactively-view-part handle))))\r
+-\r
+-(defun notmuch-show-pipe-part (message-id nth &optional filename content-type)\r
+- (notmuch-with-temp-part-buffer message-id nth\r
+- (let ((handle (mm-make-handle (current-buffer) (list content-type))))\r
+- (mm-pipe-part handle))))\r
+-\r
+ ;; This is taken from notmuch-wash: maybe it should be unified?\r
+ (defun notmuch-show-toggle-part-invisibility (&optional button)\r
+ (interactive)\r
+@@ -570,6 +520,8 @@ message at DEPTH in the current thread."\r
+ (delete-region (point) old-end))\r
+ (goto-char (min old-point (1- (button-end button))))))))\r
+ \r
++;; MIME part renderers\r
++\r
+ (defun notmuch-show-multipart/*-to-list (part)\r
+ (mapcar (lambda (inner-part) (plist-get inner-part :content-type))\r
+ (plist-get part :content)))\r
+@@ -2016,40 +1968,71 @@ the user (see `notmuch-show-stash-mlarchive-link-alist')."\r
+ (notmuch-show-stash-mlarchive-link mla)\r
+ (browse-url (current-kill 0 t)))\r
+ \r
+-;; Commands typically bound to buttons.\r
++;; Interactive part functions and their helpers\r
++\r
++(defun notmuch-show-generate-part-buffer (message-id nth)\r
++ "Return a temporary buffer containing the specified part's content."\r
++ (let ((buf (generate-new-buffer " *notmuch-part*"))\r
++ (process-crypto notmuch-show-process-crypto))\r
++ (with-current-buffer buf\r
++ (setq notmuch-show-process-crypto process-crypto)\r
++ ;; Always acquires the part via `notmuch part', even if it is\r
++ ;; available in the JSON output.\r
++ (insert (notmuch-get-bodypart-internal message-id nth notmuch-show-process-crypto)))\r
++ buf))\r
++\r
++(defun notmuch-show-current-part-handle ()\r
++ "Return an mm-handle for the part containing point.\r
++\r
++This creates a temporary buffer for the part's content; the\r
++caller is responsible for killing this buffer as appropriate."\r
++ (let* ((part (notmuch-show-get-part-properties))\r
++ (message-id (notmuch-show-get-message-id))\r
++ (nth (plist-get part :id))\r
++ (buf (notmuch-show-generate-part-buffer message-id nth))\r
++ (content-type (plist-get part :content-type))\r
++ (filename (plist-get part :filename))\r
++ (disposition (if filename `(attachment (filename . ,filename)))))\r
++ (mm-make-handle buf (list content-type) nil nil disposition)))\r
++\r
++(defun notmuch-show-apply-to-current-part-handle (fn)\r
++ "Apply FN to an mm-handle for the part containing point.\r
++\r
++This ensures that the temporary buffer created for the mm-handle\r
++is destroyed when FN returns."\r
++ (let ((handle (notmuch-show-current-part-handle)))\r
++ (unwind-protect\r
++ (funcall fn handle)\r
++ (kill-buffer (mm-handle-buffer handle)))))\r
+ \r
+ (defun notmuch-show-part-button-default (&optional button)\r
+ (interactive)\r
+ (let ((button (or button (button-at (point)))))\r
+ (if (button-get button 'overlay)\r
+ (notmuch-show-toggle-part-invisibility button)\r
+- (notmuch-show-part-button-internal button notmuch-show-part-button-default-action))))\r
++ (call-interactively notmuch-show-part-button-default-action))))\r
+ \r
+-(defun notmuch-show-part-button-save (&optional button)\r
++(defun notmuch-show-save-part ()\r
++ "Save the MIME part containing point to a file."\r
+ (interactive)\r
+- (notmuch-show-part-button-internal button #'notmuch-show-save-part))\r
++ (notmuch-show-apply-to-current-part-handle #'mm-save-part))\r
+ \r
+-(defun notmuch-show-part-button-view (&optional button)\r
++(defun notmuch-show-view-part ()\r
++ "View the MIME part containing point in an external viewer."\r
+ (interactive)\r
+- (notmuch-show-part-button-internal button #'notmuch-show-view-part))\r
++ ;; Set mm-inlined-types to nil to force an external viewer\r
++ (let ((mm-inlined-types nil))\r
++ (notmuch-show-apply-to-current-part-handle #'mm-display-part)))\r
+ \r
+-(defun notmuch-show-part-button-interactively-view (&optional button)\r
++(defun notmuch-show-interactively-view-part ()\r
++ "View the MIME part containing point, prompting for a viewer."\r
+ (interactive)\r
+- (notmuch-show-part-button-internal button #'notmuch-show-interactively-view-part))\r
++ (notmuch-show-apply-to-current-part-handle #'mm-interactively-view-part))\r
+ \r
+-(defun notmuch-show-part-button-pipe (&optional button)\r
++(defun notmuch-show-pipe-part ()\r
++ "Pipe the MIME part containing point to an external command."\r
+ (interactive)\r
+- (notmuch-show-part-button-internal button #'notmuch-show-pipe-part))\r
++ (notmuch-show-apply-to-current-part-handle #'mm-pipe-part))\r
+ \r
+-(defun notmuch-show-part-button-internal (button handler)\r
+- (let ((button (or button (button-at (point)))))\r
+- (if button\r
+- (let ((nth (button-get button :notmuch-part)))\r
+- (if nth\r
+- (funcall handler (notmuch-show-get-message-id) nth\r
+- (button-get button :notmuch-filename)\r
+- (button-get button :notmuch-content-type)))))))\r
+-\r
+-;;\r
+ \r
+ (provide 'notmuch-show)\r
+diff --git a/test/emacs b/test/emacs\r
+index f033bdf..3b26d32 100755\r
+--- a/test/emacs\r
++++ b/test/emacs\r
+@@ -525,7 +525,9 @@ test_expect_equal_file attachment1.gz "$EXPECTED/attachment"\r
+ test_begin_subtest "Save attachment from within emacs using notmuch-show-save-part"\r
+ # save as archive to test that Emacs does not re-compress .gz\r
+ test_emacs '(let ((standard-input "\"attachment2.gz\""))\r
+- (notmuch-show-save-part "id:cf0c4d610911171136h1713aa59w9cf9aa31f052ad0a@mail.gmail.com" 5))'\r
++ (notmuch-show "id:cf0c4d610911171136h1713aa59w9cf9aa31f052ad0a@mail.gmail.com")\r
++ (search-forward "0001-Deal-with")\r
++ (notmuch-show-save-part))'\r
+ test_expect_equal_file attachment2.gz "$EXPECTED/attachment"\r
+ \r
+ test_begin_subtest "Save 8bit attachment from within emacs using notmuch-show-save-attachments"\r
+-- \r
+1.7.10.4\r
+\r
projects / notmuch-archives.git / commitdiff