7e/23426d947f85b8050529493910cbb754b22a47

   1 Return-Path: <amdragon@mit.edu>\r
   2 X-Original-To: notmuch@notmuchmail.org\r
   3 Delivered-To: notmuch@notmuchmail.org\r
   4 Received: from localhost (localhost [127.0.0.1])\r
   5         by olra.theworths.org (Postfix) with ESMTP id 2F09F431FD5\r
   6         for <notmuch@notmuchmail.org>; Wed, 29 May 2013 18:14:27 -0700 (PDT)\r
   7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
   8 X-Spam-Flag: NO\r
   9 X-Spam-Score: -0.7\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=-0.7 tagged_above=-999 required=5\r
  12         tests=[RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled\r
  13 Received: from olra.theworths.org ([127.0.0.1])\r
  14         by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
  15         with ESMTP id U4GTv0fSkCL6 for <notmuch@notmuchmail.org>;\r
  16         Wed, 29 May 2013 18:14:20 -0700 (PDT)\r
  17 Received: from dmz-mailsec-scanner-5.mit.edu (dmz-mailsec-scanner-5.mit.edu\r
  18         [18.7.68.34])\r
  19         by olra.theworths.org (Postfix) with ESMTP id 91F66431FD0\r
  20         for <notmuch@notmuchmail.org>; Wed, 29 May 2013 18:14:07 -0700 (PDT)\r
  21 X-AuditID: 12074422-b7f5b6d00000095d-45-51a6a7df9f07\r
  22 Received: from mailhub-auth-3.mit.edu ( [18.9.21.43])\r
  23         by dmz-mailsec-scanner-5.mit.edu (Symantec Messaging Gateway) with SMTP\r
  24         id 58.FC.02397.FD7A6A15; Wed, 29 May 2013 21:14:07 -0400 (EDT)\r
  25 Received: from outgoing.mit.edu (outgoing-auth-1.mit.edu [18.9.28.11])\r
  26         by mailhub-auth-3.mit.edu (8.13.8/8.9.2) with ESMTP id r4U1Dtw7031314; \r
  27         Wed, 29 May 2013 21:13:56 -0400\r
  28 Received: from drake.dyndns.org (c-76-21-105-205.hsd1.ca.comcast.net\r
  29         [76.21.105.205]) (authenticated bits=0)\r
  30         (User authenticated as amdragon@ATHENA.MIT.EDU)\r
  31         by outgoing.mit.edu (8.13.8/8.12.4) with ESMTP id r4U1Dq7u003008\r
  32         (version=TLSv1/SSLv3 cipher=AES256-SHA bits=256 verify=NOT);\r
  33         Wed, 29 May 2013 21:13:54 -0400\r
  34 Received: from amthrax by drake.dyndns.org with local (Exim 4.77)\r
  35         (envelope-from <amdragon@mit.edu>)\r
  36         id 1UhrRA-0003Yu-6i; Wed, 29 May 2013 21:13:52 -0400\r
  37 From: Austin Clements <amdragon@MIT.EDU>\r
  38 To: notmuch@notmuchmail.org\r
  39 Subject: [PATCH v2 3/5] emacs: Simplify MIME part command implementation\r
  40 Date: Wed, 29 May 2013 21:13:46 -0400\r
  41 Message-Id: <1369876428-13537-4-git-send-email-amdragon@mit.edu>\r
  42 X-Mailer: git-send-email 1.7.10.4\r
  43 In-Reply-To: <1369876428-13537-1-git-send-email-amdragon@mit.edu>\r
  44 References: <1369876428-13537-1-git-send-email-amdragon@mit.edu>\r
  45 X-Brightmail-Tracker:\r
  46  H4sIAAAAAAAAA+NgFjrJIsWRmVeSWpSXmKPExsUixCmqrXt/+bJAg31buSxWz+WxuH5zJrMD\r
  47         k8fOWXfZPZ6tusUcwBTFZZOSmpNZllqkb5fAlfHu/EnmghN+Fb/vbmJsYNzn2MXIySEhYCLx\r
  48         +e0mVghbTOLCvfVsXYxcHEIC+xgl/k1uZIJwNjJK9K99xA7hnGaSONTbxALhzGWU6Jv+EKyf\r
  49         TUBDYtv+5YwgtoiAtMTOu7PB4swCjhKf9y9iA7GFBTwkFr99CFbDIqAqcehaA5jNK+Ag8ai1\r
  50         jQniDkWJ7mcTwOo5gXrft10HqxECqmn+1sc0gZF/ASPDKkbZlNwq3dzEzJzi1GTd4uTEvLzU\r
  51         Il1TvdzMEr3UlNJNjKBQYndR2sH486DSIUYBDkYlHt4NWssChVgTy4orcw8xSnIwKYnyrlkK\r
  52         FOJLyk+pzEgszogvKs1JLT7EKMHBrCTCu0YbKMebklhZlVqUD5OS5mBREue9lnLTX0ggPbEk\r
  53         NTs1tSC1CCYrw8GhJMH7dhlQo2BRanpqRVpmTglCmomDE2Q4D9DwqyA1vMUFibnFmekQ+VOM\r
  54         uhybz09+xyjEkpeflyolzvsZpEgApCijNA9uDiwFvGIUB3pLmPc1SBUPMH3ATXoFtIQJaIk4\r
  55         82KQJSWJCCmpBkbl8tTWtrxwtw6f92z1x3lYVleXNx4903xE4kiI7ouVUpGcC1Udt/3UihY5\r
  56         c2yrUOudOdnf1Kev9FG9JnfsPv+30ylxXdnvZn1h1dvE4tr6qXDi9zfy/Nfnzekt4QqdXb+i\r
  57         9V5o2ovJuv9Wdxxk/RZtxMkVGny7ba2Fb7iMVLSUX8w7xg+Gn5RYijMSDbWYi4oTAU9aVnbc        AgAA\r
  58 X-BeenThere: notmuch@notmuchmail.org\r
  59 X-Mailman-Version: 2.1.13\r
  60 Precedence: list\r
  61 List-Id: "Use and development of the notmuch mail system."\r
  62         <notmuch.notmuchmail.org>\r
  63 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  64         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  65 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  66 List-Post: <mailto:notmuch@notmuchmail.org>\r
  67 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  68 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  69         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  70 X-List-Received-Date: Thu, 30 May 2013 01:14:28 -0000\r
  71 \r
  72 This unifies the part button actions and the underlying part action\r
  73 functions into single interactive command that simply applies to the\r
  74 part containing point using the just-added part p-list text property\r
  75 instead of button properties.  Since all part actions can be performed\r
  76 by applying the appropriate mm function to an mm-handle, this patch\r
  77 abstracts out the creation of mm handles, making the implementations\r
  78 of the part commands trivial.  This also eliminates our special\r
  79 handling for part save in favor of using the appropriate mm function.\r
  80 \r
  81 This necessarily modifies the way we handle the default part button\r
  82 action, but in a way that does not change the meaning of the\r
  83 notmuch-show-part-button-default-action defcustom.\r
  84 \r
  85 Since these commands are no longer specific to buttons, this patch\r
  86 eliminates the extra metadata stored with each button.  This also\r
  87 eliminates one rather special-purpose macro for a collection of\r
  88 general purpose part handling utilities.\r
  89 ---\r
  90  emacs/notmuch-show.el |  133 +++++++++++++++++++++----------------------------\r
  91  test/emacs            |    4 +-\r
  92  2 files changed, 61 insertions(+), 76 deletions(-)\r
  93 \r
  94 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
  95 index e84e1ba..0d9a34c 100644\r
  96 --- a/emacs/notmuch-show.el\r
  97 +++ b/emacs/notmuch-show.el\r
  98 @@ -474,10 +474,10 @@ message at DEPTH in the current thread."\r
  99  (defvar notmuch-show-part-button-map\r
 100    (let ((map (make-sparse-keymap)))\r
 101      (set-keymap-parent map button-map)\r
 102 -    (define-key map "s" 'notmuch-show-part-button-save)\r
 103 -    (define-key map "v" 'notmuch-show-part-button-view)\r
 104 -    (define-key map "o" 'notmuch-show-part-button-interactively-view)\r
 105 -    (define-key map "|" 'notmuch-show-part-button-pipe)\r
 106 +    (define-key map "s" 'notmuch-show-save-part)\r
 107 +    (define-key map "v" 'notmuch-show-view-part)\r
 108 +    (define-key map "o" 'notmuch-show-interactively-view-part)\r
 109 +    (define-key map "|" 'notmuch-show-pipe-part)\r
 110      map)\r
 111    "Submap for button commands")\r
 112  (fset 'notmuch-show-part-button-map notmuch-show-part-button-map)\r
 113 @@ -494,61 +494,11 @@ message at DEPTH in the current thread."\r
 114           (insert-button\r
 115            (concat "[ " base-label " ]")\r
 116            :base-label base-label\r
 117 -          :type 'notmuch-show-part-button-type\r
 118 -          :notmuch-part nth\r
 119 -          :notmuch-filename name\r
 120 -          :notmuch-content-type content-type))\r
 121 +          :type 'notmuch-show-part-button-type))\r
 122      (insert "\n")\r
 123      ;; return button\r
 124      button))\r
 125  \r
 126 -;; Functions handling particular MIME parts.\r
 127 -\r
 128 -(defmacro notmuch-with-temp-part-buffer (message-id nth &rest body)\r
 129 -  (declare (indent 2))\r
 130 -  (let ((process-crypto (make-symbol "process-crypto")))\r
 131 -    `(let ((,process-crypto notmuch-show-process-crypto))\r
 132 -       (with-temp-buffer\r
 133 -        (setq notmuch-show-process-crypto ,process-crypto)\r
 134 -        ;; Always acquires the part via `notmuch part', even if it is\r
 135 -        ;; available in the JSON output.\r
 136 -        (insert (notmuch-get-bodypart-internal ,message-id ,nth notmuch-show-process-crypto))\r
 137 -        ,@body))))\r
 138 -\r
 139 -(defun notmuch-show-save-part (message-id nth &optional filename content-type)\r
 140 -  (notmuch-with-temp-part-buffer message-id nth\r
 141 -    (let ((file (read-file-name\r
 142 -                "Filename to save as: "\r
 143 -                (or mailcap-download-directory "~/")\r
 144 -                nil nil\r
 145 -                filename)))\r
 146 -      ;; Don't re-compress .gz & al.  Arguably we should make\r
 147 -      ;; `file-name-handler-alist' nil, but that would chop\r
 148 -      ;; ange-ftp, which is reasonable to use here.\r
 149 -      (mm-write-region (point-min) (point-max) file nil nil nil 'no-conversion t))))\r
 150 -\r
 151 -(defun notmuch-show-view-part (message-id nth &optional filename content-type )\r
 152 -  (notmuch-with-temp-part-buffer message-id nth\r
 153 -    (let* ((disposition (if filename `(attachment (filename . ,filename))))\r
 154 -          (handle (mm-make-handle (current-buffer) (list content-type)\r
 155 -                                  nil nil disposition))\r
 156 -          ;; Set the default save directory to be consistent with\r
 157 -          ;; `notmuch-show-save-part'.\r
 158 -          (mm-default-directory (or mailcap-download-directory "~/"))\r
 159 -          ;; set mm-inlined-types to nil to force an external viewer\r
 160 -          (mm-inlined-types nil))\r
 161 -      (mm-display-part handle))))\r
 162 -\r
 163 -(defun notmuch-show-interactively-view-part (message-id nth &optional filename content-type)\r
 164 -  (notmuch-with-temp-part-buffer message-id nth\r
 165 -    (let ((handle (mm-make-handle (current-buffer) (list content-type))))\r
 166 -      (mm-interactively-view-part handle))))\r
 167 -\r
 168 -(defun notmuch-show-pipe-part (message-id nth &optional filename content-type)\r
 169 -  (notmuch-with-temp-part-buffer message-id nth\r
 170 -    (let ((handle (mm-make-handle (current-buffer) (list content-type))))\r
 171 -      (mm-pipe-part handle))))\r
 172 -\r
 173  ;; This is taken from notmuch-wash: maybe it should be unified?\r
 174  (defun notmuch-show-toggle-part-invisibility (&optional button)\r
 175    (interactive)\r
 176 @@ -570,6 +520,8 @@ message at DEPTH in the current thread."\r
 177           (delete-region (point) old-end))\r
 178         (goto-char (min old-point (1- (button-end button))))))))\r
 179  \r
 180 +;; MIME part renderers\r
 181 +\r
 182  (defun notmuch-show-multipart/*-to-list (part)\r
 183    (mapcar (lambda (inner-part) (plist-get inner-part :content-type))\r
 184           (plist-get part :content)))\r
 185 @@ -2023,40 +1975,71 @@ the user (see `notmuch-show-stash-mlarchive-link-alist')."\r
 186    (notmuch-show-stash-mlarchive-link mla)\r
 187    (browse-url (current-kill 0 t)))\r
 188  \r
 189 -;; Commands typically bound to buttons.\r
 190 +;; Interactive part functions and their helpers\r
 191 +\r
 192 +(defun notmuch-show-generate-part-buffer (message-id nth)\r
 193 +  "Return a temporary buffer containing the specified part's content."\r
 194 +  (let ((buf (generate-new-buffer " *notmuch-part*"))\r
 195 +       (process-crypto notmuch-show-process-crypto))\r
 196 +    (with-current-buffer buf\r
 197 +      (setq notmuch-show-process-crypto process-crypto)\r
 198 +      ;; Always acquires the part via `notmuch part', even if it is\r
 199 +      ;; available in the JSON output.\r
 200 +      (insert (notmuch-get-bodypart-internal message-id nth notmuch-show-process-crypto)))\r
 201 +    buf))\r
 202 +\r
 203 +(defun notmuch-show-current-part-handle ()\r
 204 +  "Return an mm-handle for the part containing point.\r
 205 +\r
 206 +This creates a temporary buffer for the part's content; the\r
 207 +caller is responsible for killing this buffer as appropriate."\r
 208 +  (let* ((part (notmuch-show-get-part-properties))\r
 209 +        (message-id (notmuch-show-get-message-id))\r
 210 +        (nth (plist-get part :id))\r
 211 +        (buf (notmuch-show-generate-part-buffer message-id nth))\r
 212 +        (content-type (plist-get part :content-type))\r
 213 +        (filename (plist-get part :filename))\r
 214 +        (disposition (if filename `(attachment (filename . ,filename)))))\r
 215 +    (mm-make-handle buf (list content-type) nil nil disposition)))\r
 216 +\r
 217 +(defun notmuch-show-apply-to-current-part-handle (fn)\r
 218 +  "Apply FN to an mm-handle for the part containing point.\r
 219 +\r
 220 +This ensures that the temporary buffer created for the mm-handle\r
 221 +is destroyed when FN returns."\r
 222 +  (let ((handle (notmuch-show-current-part-handle)))\r
 223 +    (unwind-protect\r
 224 +       (funcall fn handle)\r
 225 +      (kill-buffer (mm-handle-buffer handle)))))\r
 226  \r
 227  (defun notmuch-show-part-button-default (&optional button)\r
 228    (interactive)\r
 229    (let ((button (or button (button-at (point)))))\r
 230      (if (button-get button 'overlay)\r
 231         (notmuch-show-toggle-part-invisibility button)\r
 232 -      (notmuch-show-part-button-internal button notmuch-show-part-button-default-action))))\r
 233 +      (call-interactively notmuch-show-part-button-default-action))))\r
 234  \r
 235 -(defun notmuch-show-part-button-save (&optional button)\r
 236 +(defun notmuch-show-save-part ()\r
 237 +  "Save the MIME part containing point to a file."\r
 238    (interactive)\r
 239 -  (notmuch-show-part-button-internal button #'notmuch-show-save-part))\r
 240 +  (notmuch-show-apply-to-current-part-handle #'mm-save-part))\r
 241  \r
 242 -(defun notmuch-show-part-button-view (&optional button)\r
 243 +(defun notmuch-show-view-part ()\r
 244 +  "View the MIME part containing point in an external viewer."\r
 245    (interactive)\r
 246 -  (notmuch-show-part-button-internal button #'notmuch-show-view-part))\r
 247 +  ;; Set mm-inlined-types to nil to force an external viewer\r
 248 +  (let ((mm-inlined-types nil))\r
 249 +    (notmuch-show-apply-to-current-part-handle #'mm-display-part)))\r
 250  \r
 251 -(defun notmuch-show-part-button-interactively-view (&optional button)\r
 252 +(defun notmuch-show-interactively-view-part ()\r
 253 +  "View the MIME part containing point, prompting for a viewer."\r
 254    (interactive)\r
 255 -  (notmuch-show-part-button-internal button #'notmuch-show-interactively-view-part))\r
 256 +  (notmuch-show-apply-to-current-part-handle #'mm-interactively-view-part))\r
 257  \r
 258 -(defun notmuch-show-part-button-pipe (&optional button)\r
 259 +(defun notmuch-show-pipe-part ()\r
 260 +  "Pipe the MIME part containing point to an external command."\r
 261    (interactive)\r
 262 -  (notmuch-show-part-button-internal button #'notmuch-show-pipe-part))\r
 263 +  (notmuch-show-apply-to-current-part-handle #'mm-pipe-part))\r
 264  \r
 265 -(defun notmuch-show-part-button-internal (button handler)\r
 266 -  (let ((button (or button (button-at (point)))))\r
 267 -    (if button\r
 268 -       (let ((nth (button-get button :notmuch-part)))\r
 269 -         (if nth\r
 270 -             (funcall handler (notmuch-show-get-message-id) nth\r
 271 -                      (button-get button :notmuch-filename)\r
 272 -                      (button-get button :notmuch-content-type)))))))\r
 273 -\r
 274 -;;\r
 275  \r
 276  (provide 'notmuch-show)\r
 277 diff --git a/test/emacs b/test/emacs\r
 278 index f033bdf..3b26d32 100755\r
 279 --- a/test/emacs\r
 280 +++ b/test/emacs\r
 281 @@ -525,7 +525,9 @@ test_expect_equal_file attachment1.gz "$EXPECTED/attachment"\r
 282  test_begin_subtest "Save attachment from within emacs using notmuch-show-save-part"\r
 283  # save as archive to test that Emacs does not re-compress .gz\r
 284  test_emacs '(let ((standard-input "\"attachment2.gz\""))\r
 285 -             (notmuch-show-save-part "id:cf0c4d610911171136h1713aa59w9cf9aa31f052ad0a@mail.gmail.com" 5))'\r
 286 +             (notmuch-show "id:cf0c4d610911171136h1713aa59w9cf9aa31f052ad0a@mail.gmail.com")\r
 287 +             (search-forward "0001-Deal-with")\r
 288 +             (notmuch-show-save-part))'\r
 289  test_expect_equal_file attachment2.gz "$EXPECTED/attachment"\r
 290  \r
 291  test_begin_subtest "Save 8bit attachment from within emacs using notmuch-show-save-attachments"\r
 292 -- \r
 293 1.7.10.4\r
 294 \r