c5/b1b65bb9e7114f89ecff980b0880f35bf77635

   1 Return-Path: <awg@lagos.xvx.ca>\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 5D1BB431FAE\r
   6         for <notmuch@notmuchmail.org>; Sun, 18 Mar 2012 09:33:07 -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\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=0 tagged_above=-999 required=5\r
  12         tests=[RCVD_IN_DNSWL_NONE=-0.0001] 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 sr8Myo2+-dzo for <notmuch@notmuchmail.org>;\r
  16         Sun, 18 Mar 2012 09:33:03 -0700 (PDT)\r
  17 Received: from idcmail-mo2no.shaw.ca (idcmail-mo2no.shaw.ca [64.59.134.9])\r
  18         by olra.theworths.org (Postfix) with ESMTP id 1B83F431FD5\r
  19         for <notmuch@notmuchmail.org>; Sun, 18 Mar 2012 09:33:01 -0700 (PDT)\r
  20 Received: from lb7f8hsrpno-svcs.dcs.int.inet (HELO pd6ml2no-ssvc.prod.shaw.ca)\r
  21         ([10.0.144.222])\r
  22         by pd6mo1no-svcs.prod.shaw.ca with ESMTP; 18 Mar 2012 10:33:00 -0600\r
  23 X-Cloudmark-SP-Filtered: true\r
  24 X-Cloudmark-SP-Result: v=1.1 cv=oQE6vNJ3d7oTBHj4PDKYH99BAdyPlqTp0xAtaaBYR4E=\r
  25         c=1 sm=1\r
  26         a=4vT4Kfs2-XgA:10 a=BLceEmwcHowA:10 a=yQp6g8lIsgqumF79BAsFDg==:17\r
  27         a=H4IEW4q-AAAA:8 a=7343-z1_AAAA:8 a=pGLkceISAAAA:8\r
  28         a=pkj2EqAftlighcz09hEA:9\r
  29         a=GfdN2rCGAuq2ylZorScA:7 a=0BPXsuqt4rsA:10 a=Kw4u8EAyA4wA:10\r
  30         a=0c-eHkXYtrgA:10 a=Ka2vHfUGn-E_Sbxc:21 a=xsk0_cFsgf0rMD6X:21\r
  31         a=HpAAvcLHHh0Zw7uRqdWCyQ==:117\r
  32 Received: from unknown (HELO lagos.xvx.ca) ([96.52.216.56])\r
  33         by pd6ml2no-dmz.prod.shaw.ca with ESMTP; 18 Mar 2012 10:33:00 -0600\r
  34 Received: by lagos.xvx.ca (Postfix, from userid 1000)\r
  35         id 99F7B8004204; Sun, 18 Mar 2012 10:33:00 -0600 (MDT)\r
  36 From: Adam Wolfe Gordon <awg+notmuch@xvx.ca>\r
  37 To: notmuch@notmuchmail.org\r
  38 Subject: [PATCH v8 10/11] emacs: Use the new JSON reply format and\r
  39         message-cite-original\r
  40 Date: Sun, 18 Mar 2012 10:32:42 -0600\r
  41 Message-Id: <1332088363-22476-11-git-send-email-awg+notmuch@xvx.ca>\r
  42 X-Mailer: git-send-email 1.7.5.4\r
  43 In-Reply-To: <1332088363-22476-1-git-send-email-awg+notmuch@xvx.ca>\r
  44 References: <87fwd6kqtv.fsf@zancas.localnet>\r
  45         <1332088363-22476-1-git-send-email-awg+notmuch@xvx.ca>\r
  46 X-BeenThere: notmuch@notmuchmail.org\r
  47 X-Mailman-Version: 2.1.13\r
  48 Precedence: list\r
  49 List-Id: "Use and development of the notmuch mail system."\r
  50         <notmuch.notmuchmail.org>\r
  51 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  52         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  53 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  54 List-Post: <mailto:notmuch@notmuchmail.org>\r
  55 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  56 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  57         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  58 X-List-Received-Date: Sun, 18 Mar 2012 16:33:07 -0000\r
  59 \r
  60 Use the new JSON reply format to create replies in emacs. Quote HTML\r
  61 parts nicely by using mm-display-part to turn them into displayable\r
  62 text, then quoting them with message-cite-original. This is very\r
  63 useful for users who regularly receive HTML-only email.\r
  64 \r
  65 Use message-mode's message-cite-original function to create the\r
  66 quoted body for reply messages. In order to make this act like the\r
  67 existing notmuch defaults, you will need to set the following in\r
  68 your emacs configuration:\r
  69 \r
  70 message-citation-line-format "On %a, %d %b %Y, %f wrote:"\r
  71 message-citation-line-function 'message-insert-formatted-citation-line\r
  72 \r
  73 The tests have been updated to reflect the (ugly) emacs default.\r
  74 ---\r
  75  emacs/notmuch-lib.el  |   30 ++++++++++++\r
  76  emacs/notmuch-mua.el  |  124 +++++++++++++++++++++++++++++++++----------------\r
  77  emacs/notmuch-show.el |   31 ++----------\r
  78  test/emacs            |    8 ++--\r
  79  4 files changed, 123 insertions(+), 70 deletions(-)\r
  80 \r
  81 diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
  82 index 7e3f110..c146748 100644\r
  83 --- a/emacs/notmuch-lib.el\r
  84 +++ b/emacs/notmuch-lib.el\r
  85 @@ -206,6 +206,36 @@ the user hasn't set this variable with the old or new value."\r
  86           (setq seq (nconc (delete elem seq) (list elem))))))\r
  87      seq))\r
  88  \r
  89 +(defun notmuch-parts-filter-by-type (parts type)\r
  90 +  "Given a list of message parts, return a list containing the ones matching\r
  91 +the given type."\r
  92 +  (remove-if-not\r
  93 +   (lambda (part) (notmuch-match-content-type (plist-get part :content-type) type))\r
  94 +   parts))\r
  95 +\r
  96 +;; Helper for parts which are generally not included in the default\r
  97 +;; JSON output.\r
  98 +(defun notmuch-get-bodypart-internal (message-id part-number process-crypto)\r
  99 +  (let ((args '("show" "--format=raw"))\r
 100 +       (part-arg (format "--part=%s" part-number)))\r
 101 +    (setq args (append args (list part-arg)))\r
 102 +    (if process-crypto\r
 103 +       (setq args (append args '("--decrypt"))))\r
 104 +    (setq args (append args (list message-id)))\r
 105 +    (with-temp-buffer\r
 106 +      (let ((coding-system-for-read 'no-conversion))\r
 107 +       (progn\r
 108 +         (apply 'call-process (append (list notmuch-command nil (list t nil) nil) args))\r
 109 +         (buffer-string))))))\r
 110 +\r
 111 +(defun notmuch-get-bodypart-content (msg part nth process-crypto)\r
 112 +  (or (plist-get part :content)\r
 113 +      (notmuch-get-bodypart-internal (concat "id:" (plist-get msg :id)) nth process-crypto)))\r
 114 +\r
 115 +(defun notmuch-plist-to-alist (plist)\r
 116 +  (loop for (key value . rest) on plist by #'cddr\r
 117 +       collect (cons (substring (symbol-name key) 1) value)))\r
 118 +\r
 119  ;; Compatibility functions for versions of emacs before emacs 23.\r
 120  ;;\r
 121  ;; Both functions here were copied from emacs 23 with the following copyright:\r
 122 diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el\r
 123 index 13244eb..6aae3a0 100644\r
 124 --- a/emacs/notmuch-mua.el\r
 125 +++ b/emacs/notmuch-mua.el\r
 126 @@ -19,11 +19,15 @@\r
 127  ;;\r
 128  ;; Authors: David Edmondson <dme@dme.org>\r
 129  \r
 130 +(require 'json)\r
 131  (require 'message)\r
 132 +(require 'format-spec)\r
 133  \r
 134  (require 'notmuch-lib)\r
 135  (require 'notmuch-address)\r
 136  \r
 137 +(eval-when-compile (require 'cl))\r
 138 +\r
 139  ;;\r
 140  \r
 141  (defcustom notmuch-mua-send-hook '(notmuch-mua-message-send-hook)\r
 142 @@ -72,54 +76,92 @@ list."\r
 143             (push header message-hidden-headers)))\r
 144         notmuch-mua-hidden-headers))\r
 145  \r
 146 +(defun notmuch-mua-get-quotable-parts (parts)\r
 147 +  (loop for part in parts\r
 148 +       if (notmuch-match-content-type (plist-get part :content-type) "multipart/alternative")\r
 149 +         collect (let* ((subparts (plist-get part :content))\r
 150 +                       (types (mapcar (lambda (part) (plist-get part :content-type)) subparts))\r
 151 +                       (chosen-type (car (notmuch-multipart/alternative-choose types))))\r
 152 +                  (loop for part in (reverse subparts)\r
 153 +                        if (notmuch-match-content-type (plist-get part :content-type) chosen-type)\r
 154 +                        return part))\r
 155 +       else if (notmuch-match-content-type (plist-get part :content-type) "multipart/*")\r
 156 +         append (notmuch-mua-get-quotable-parts (plist-get part :content))\r
 157 +       else if (notmuch-match-content-type (plist-get part :content-type) "text/*")\r
 158 +         collect part))\r
 159 +\r
 160  (defun notmuch-mua-reply (query-string &optional sender reply-all)\r
 161 -  (let (headers\r
 162 -       body\r
 163 -       (args '("reply")))\r
 164 -    (if notmuch-show-process-crypto\r
 165 -       (setq args (append args '("--decrypt"))))\r
 166 +  (let ((args '("reply" "--format=json"))\r
 167 +       reply\r
 168 +       original)\r
 169 +    (when notmuch-show-process-crypto\r
 170 +      (setq args (append args '("--decrypt"))))\r
 171 +\r
 172      (if reply-all\r
 173         (setq args (append args '("--reply-to=all")))\r
 174        (setq args (append args '("--reply-to=sender"))))\r
 175      (setq args (append args (list query-string)))\r
 176 -    ;; This make assumptions about the output of `notmuch reply', but\r
 177 -    ;; really only that the headers come first followed by a blank\r
 178 -    ;; line and then the body.\r
 179 +\r
 180 +    ;; Get the reply object as JSON, and parse it into an elisp object.\r
 181      (with-temp-buffer\r
 182        (apply 'call-process (append (list notmuch-command nil (list t t) nil) args))\r
 183        (goto-char (point-min))\r
 184 -      (if (re-search-forward "^$" nil t)\r
 185 -         (save-excursion\r
 186 -           (save-restriction\r
 187 -             (narrow-to-region (point-min) (point))\r
 188 -             (goto-char (point-min))\r
 189 -             (setq headers (mail-header-extract)))))\r
 190 -      (forward-line 1)\r
 191 -      ;; Original message may contain (malicious) MML tags. We must\r
 192 -      ;; properly quote them in the reply.\r
 193 -      (mml-quote-region (point) (point-max))\r
 194 -      (setq body (buffer-substring (point) (point-max))))\r
 195 -    ;; If sender is non-nil, set the From: header to its value.\r
 196 -    (when sender\r
 197 -      (mail-header-set 'from sender headers))\r
 198 -    (let\r
 199 -       ;; Overlay the composition window on that being used to read\r
 200 -       ;; the original message.\r
 201 -       ((same-window-regexps '("\\*mail .*")))\r
 202 -      (notmuch-mua-mail (mail-header 'to headers)\r
 203 -                       (mail-header 'subject headers)\r
 204 -                       (message-headers-to-generate headers t '(to subject))))\r
 205 -    ;; insert the message body - but put it in front of the signature\r
 206 -    ;; if one is present\r
 207 -    (goto-char (point-max))\r
 208 -    (if (re-search-backward message-signature-separator nil t)\r
 209 +      (let ((json-object-type 'plist)\r
 210 +           (json-array-type 'list)\r
 211 +           (json-false 'nil))\r
 212 +       (setq reply (json-read))))\r
 213 +\r
 214 +    ;; Extract the original message to simplify the following code.\r
 215 +    (setq original (plist-get reply :original))\r
 216 +\r
 217 +    ;; Extract the headers of both the reply and the original message.\r
 218 +    (let* ((original-headers (plist-get original :headers))\r
 219 +          (reply-headers (plist-get reply :reply-headers)))\r
 220 +\r
 221 +      ;; If sender is non-nil, set the From: header to its value.\r
 222 +      (when sender\r
 223 +       (plist-put reply-headers :From sender))\r
 224 +      (let\r
 225 +         ;; Overlay the composition window on that being used to read\r
 226 +         ;; the original message.\r
 227 +         ((same-window-regexps '("\\*mail .*")))\r
 228 +       (notmuch-mua-mail (plist-get reply-headers :To)\r
 229 +                         (plist-get reply-headers :Subject)\r
 230 +                         (notmuch-plist-to-alist reply-headers)))\r
 231 +      ;; Insert the message body - but put it in front of the signature\r
 232 +      ;; if one is present\r
 233 +      (goto-char (point-max))\r
 234 +      (if (re-search-backward message-signature-separator nil t)\r
 235           (forward-line -1)\r
 236 -      (goto-char (point-max)))\r
 237 -    (insert body)\r
 238 -    (push-mark))\r
 239 -  (set-buffer-modified-p nil)\r
 240 -\r
 241 -  (message-goto-body))\r
 242 +       (goto-char (point-max)))\r
 243 +\r
 244 +      (let ((from (plist-get original-headers :From))\r
 245 +           (date (plist-get original-headers :Date))\r
 246 +           (start (point)))\r
 247 +\r
 248 +       ;; message-cite-original constructs a citation line based on the From and Date\r
 249 +       ;; headers of the original message, which are assumed to be in the buffer.\r
 250 +       (insert "From: " from "\n")\r
 251 +       (insert "Date: " date "\n\n")\r
 252 +\r
 253 +       ;; Get the parts of the original message that should be quoted; this includes\r
 254 +       ;; all the text parts, except the non-preferred ones in a multipart/alternative.\r
 255 +       (let ((quotable-parts (notmuch-mua-get-quotable-parts (plist-get original :body))))\r
 256 +         (mapc (lambda (part)\r
 257 +                 (insert (notmuch-get-bodypart-content original part\r
 258 +                                                       (plist-get part :id)\r
 259 +                                                       notmuch-show-process-crypto)))\r
 260 +               quotable-parts))\r
 261 +\r
 262 +       (set-mark (point))\r
 263 +       (goto-char start)\r
 264 +       ;; Quote the original message according to the user's configured style.\r
 265 +       (message-cite-original))))\r
 266 +\r
 267 +  (goto-char (point-max))\r
 268 +  (push-mark)\r
 269 +  (message-goto-body)\r
 270 +  (set-buffer-modified-p nil))\r
 271  \r
 272  (defun notmuch-mua-forward-message ()\r
 273    (message-forward)\r
 274 @@ -145,7 +187,7 @@ OTHER-ARGS are passed through to `message-mail'."\r
 275        (when (not (string= "" user-agent))\r
 276         (push (cons "User-Agent" user-agent) other-headers))))\r
 277  \r
 278 -  (unless (mail-header 'from other-headers)\r
 279 +  (unless (mail-header 'From other-headers)\r
 280      (push (cons "From" (concat\r
 281                         (notmuch-user-name) " <" (notmuch-user-primary-email) ">")) other-headers))\r
 282  \r
 283 @@ -208,7 +250,7 @@ the From: address first."\r
 284    (interactive "P")\r
 285    (let ((other-headers\r
 286          (when (or prompt-for-sender notmuch-always-prompt-for-sender)\r
 287 -          (list (cons 'from (notmuch-mua-prompt-for-sender))))))\r
 288 +          (list (cons 'From (notmuch-mua-prompt-for-sender))))))\r
 289      (notmuch-mua-mail nil nil other-headers)))\r
 290  \r
 291  (defun notmuch-mua-new-forward-message (&optional prompt-for-sender)\r
 292 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
 293 index ed938bf..0cd7d82 100644\r
 294 --- a/emacs/notmuch-show.el\r
 295 +++ b/emacs/notmuch-show.el\r
 296 @@ -488,7 +488,7 @@ message at DEPTH in the current thread."\r
 297          (setq notmuch-show-process-crypto ,process-crypto)\r
 298          ;; Always acquires the part via `notmuch part', even if it is\r
 299          ;; available in the JSON output.\r
 300 -        (insert (notmuch-show-get-bodypart-internal ,message-id ,nth))\r
 301 +        (insert (notmuch-get-bodypart-internal ,message-id ,nth notmuch-show-process-crypto))\r
 302          ,@body))))\r
 303  \r
 304  (defun notmuch-show-save-part (message-id nth &optional filename content-type)\r
 305 @@ -536,7 +536,7 @@ current buffer, if possible."\r
 306         ;; test whether we are able to inline it (which includes both\r
 307         ;; capability and suitability tests).\r
 308         (when (mm-inlined-p handle)\r
 309 -         (insert (notmuch-show-get-bodypart-content msg part nth))\r
 310 +         (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))\r
 311           (when (mm-inlinable-p handle)\r
 312             (set-buffer display-buffer)\r
 313             (mm-display-part handle)\r
 314 @@ -613,8 +613,8 @@ current buffer, if possible."\r
 315           ;; times (hundreds!), which results in many calls to\r
 316           ;; `notmuch part'.\r
 317           (unless content\r
 318 -           (setq content (notmuch-show-get-bodypart-internal (concat "id:" message-id)\r
 319 -                                                             part-number))\r
 320 +           (setq content (notmuch-get-bodypart-internal (concat "id:" message-id)\r
 321 +                                                             part-number notmuch-show-process-crypto))\r
 322             (with-current-buffer w3m-current-buffer\r
 323               (notmuch-show-w3m-cid-store-internal url\r
 324                                                    message-id\r
 325 @@ -734,7 +734,7 @@ current buffer, if possible."\r
 326      ;; insert a header to make this clear.\r
 327      (if (> nth 1)\r
 328         (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename)))\r
 329 -    (insert (notmuch-show-get-bodypart-content msg part nth))\r
 330 +    (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))\r
 331      (save-excursion\r
 332        (save-restriction\r
 333         (narrow-to-region start (point-max))\r
 334 @@ -744,7 +744,7 @@ current buffer, if possible."\r
 335  (defun notmuch-show-insert-part-text/calendar (msg part content-type nth depth declared-type)\r
 336    (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))\r
 337    (insert (with-temp-buffer\r
 338 -           (insert (notmuch-show-get-bodypart-content msg part nth))\r
 339 +           (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))\r
 340             (goto-char (point-min))\r
 341             (let ((file (make-temp-file "notmuch-ical"))\r
 342                   result)\r
 343 @@ -806,25 +806,6 @@ current buffer, if possible."\r
 344                 (intern (concat "notmuch-show-insert-part-" content-type))))\r
 345      result))\r
 346  \r
 347 -;; Helper for parts which are generally not included in the default\r
 348 -;; JSON output.\r
 349 -(defun notmuch-show-get-bodypart-internal (message-id part-number)\r
 350 -  (let ((args '("show" "--format=raw"))\r
 351 -       (part-arg (format "--part=%s" part-number)))\r
 352 -    (setq args (append args (list part-arg)))\r
 353 -    (if notmuch-show-process-crypto\r
 354 -       (setq args (append args '("--decrypt"))))\r
 355 -    (setq args (append args (list message-id)))\r
 356 -    (with-temp-buffer\r
 357 -      (let ((coding-system-for-read 'no-conversion))\r
 358 -       (progn\r
 359 -         (apply 'call-process (append (list notmuch-command nil (list t nil) nil) args))\r
 360 -         (buffer-string))))))\r
 361 -\r
 362 -(defun notmuch-show-get-bodypart-content (msg part nth)\r
 363 -  (or (plist-get part :content)\r
 364 -      (notmuch-show-get-bodypart-internal (concat "id:" (plist-get msg :id)) nth)))\r
 365 -\r
 366  ;; \f\r
 367 \r
 368  \r
 369  (defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth declared-type)\r
 370 diff --git a/test/emacs b/test/emacs\r
 371 index 01afdb6..8a28705 100755\r
 372 --- a/test/emacs\r
 373 +++ b/test/emacs\r
 374 @@ -268,13 +268,13 @@ Subject: Re: Testing message sent via SMTP\r
 375  In-Reply-To: <XXX>\r
 376  Fcc: ${MAIL_DIR}/sent\r
 377  --text follows this line--\r
 378 -On 01 Jan 2000 12:00:00 -0000, Notmuch Test Suite <test_suite@notmuchmail.org> wrote:\r
 379 +Notmuch Test Suite <test_suite@notmuchmail.org> writes:\r
 380 +\r
 381  > This is a test that messages are sent via SMTP\r
 382  EOF\r
 383  test_expect_equal_file OUTPUT EXPECTED\r
 384  \r
 385  test_begin_subtest "Reply within emacs to a multipart/mixed message"\r
 386 -test_subtest_known_broken\r
 387  test_emacs '(notmuch-show "id:20091118002059.067214ed@hikari")\r
 388                 (notmuch-show-reply)\r
 389                 (test-output)'\r
 390 @@ -334,7 +334,6 @@ EOF\r
 391  test_expect_equal_file OUTPUT EXPECTED\r
 392  \r
 393  test_begin_subtest "Reply within emacs to a multipart/alternative message"\r
 394 -test_subtest_known_broken\r
 395  test_emacs '(notmuch-show "id:cf0c4d610911171136h1713aa59w9cf9aa31f052ad0a@mail.gmail.com")\r
 396                 (notmuch-show-reply)\r
 397                 (test-output)'\r
 398 @@ -385,7 +384,8 @@ Subject: Re: Quote MML tags in reply\r
 399  In-Reply-To: <test-emacs-mml-quoting@message.id>\r
 400  Fcc: ${MAIL_DIR}/sent\r
 401  --text follows this line--\r
 402 -On Fri, 05 Jan 2001 15:43:57 +0000, Notmuch Test Suite <test_suite@notmuchmail.org> wrote:\r
 403 +Notmuch Test Suite <test_suite@notmuchmail.org> writes:\r
 404 +\r
 405  > <#!part disposition=inline>\r
 406  EOF\r
 407  test_expect_equal_file OUTPUT EXPECTED\r
 408 -- \r
 409 1.7.5.4\r
 410 \r