60/fb242fd345bd0295d47f6c06c36fd78c453756

   1 Return-Path: <jani@nikula.org>\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 A4EA3431FBC\r
   6         for <notmuch@notmuchmail.org>; Fri,  9 Mar 2012 15:13:21 -0800 (PST)\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 DKXNnSgUQK6s for <notmuch@notmuchmail.org>;\r
  16         Fri,  9 Mar 2012 15:13:20 -0800 (PST)\r
  17 Received: from mail-lb0-f181.google.com (mail-lb0-f181.google.com\r
  18         [209.85.217.181]) (using TLSv1 with cipher RC4-SHA (128/128 bits))\r
  19         (No client certificate requested)\r
  20         by olra.theworths.org (Postfix) with ESMTPS id 1E6C2431FAE\r
  21         for <notmuch@notmuchmail.org>; Fri,  9 Mar 2012 15:13:19 -0800 (PST)\r
  22 Received: by lbok6 with SMTP id k6so632523lbo.26\r
  23         for <notmuch@notmuchmail.org>; Fri, 09 Mar 2012 15:13:18 -0800 (PST)\r
  24 X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;\r
  25         d=google.com; s=20120113;\r
  26         h=from:to:subject:in-reply-to:references:user-agent:date:message-id\r
  27         :mime-version:content-type:x-gm-message-state;\r
  28         bh=2dhXcEMrTypVzxnVMKAI8EgGJ2wGdH8rqjVOLqY9Eq4=;\r
  29         b=MCorLlbZxlJN3eDftsXtJLxcb+vLmxoCrj/IFCGEc7LJdeykhDjvjujbrofPWMNG8I\r
  30         +U0dkPhwPkeD4tKdYPF8b1xcOR9z87NLRTC8jvmXN0NOVadGUfb82Bd3pH/L3g6SSDJu\r
  31         fXesdRCge+40II4b5VgjHItd0k7YDoitEuP/75QEIlKyDqFuuNDsC7+0HCMk48eHJ2+x\r
  32         vKbHDMHP/YMCrauEjnByio4apE0yQd2HhDKFDHEyzQWz9vcRXzQx5JPIkupoa0iDNFT7\r
  33         BzfKLZlDp7i20DgH0z49ECmmld8NdG3X2FHiygJzUoJfsCVGsWK94O9uqFJ6KRa1reBa\r
  34         FKog==\r
  35 Received: by 10.112.29.200 with SMTP id m8mr1515886lbh.44.1331334798482;\r
  36         Fri, 09 Mar 2012 15:13:18 -0800 (PST)\r
  37 Received: from localhost (dsl-hkibrasgw4-fe50f800-253.dhcp.inet.fi.\r
  38         [84.248.80.253])\r
  39         by mx.google.com with ESMTPS id ox6sm5965375lab.12.2012.03.09.15.13.16\r
  40         (version=SSLv3 cipher=OTHER); Fri, 09 Mar 2012 15:13:17 -0800 (PST)\r
  41 From: Jani Nikula <jani@nikula.org>\r
  42 To: Adam Wolfe Gordon <awg+notmuch@xvx.ca>, notmuch@notmuchmail.org\r
  43 Subject: Re: [PATCH v6] emacs: Use the new JSON reply format and\r
  44         message-cite-original\r
  45 In-Reply-To: <1329893199-21630-11-git-send-email-awg+notmuch@xvx.ca>\r
  46 References: <1329893199-21630-1-git-send-email-awg+notmuch@xvx.ca>\r
  47         <1329893199-21630-11-git-send-email-awg+notmuch@xvx.ca>\r
  48 User-Agent: Notmuch/0.11.1+295~g780f284 (http://notmuchmail.org) Emacs/23.3.1\r
  49         (i686-pc-linux-gnu)\r
  50 Date: Sat, 10 Mar 2012 01:13:14 +0200\r
  51 Message-ID: <87aa3p8j1x.fsf@nikula.org>\r
  52 MIME-Version: 1.0\r
  53 Content-Type: text/plain; charset=us-ascii\r
  54 X-Gm-Message-State:\r
  55  ALoCoQnnc8uiiAQjGN1xDBKLrDbUrK85HucztW+toCTMKlrZuW3Xsovayh+akygb4MGly27Gexy3\r
  56 X-BeenThere: notmuch@notmuchmail.org\r
  57 X-Mailman-Version: 2.1.13\r
  58 Precedence: list\r
  59 List-Id: "Use and development of the notmuch mail system."\r
  60         <notmuch.notmuchmail.org>\r
  61 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  62         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  63 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  64 List-Post: <mailto:notmuch@notmuchmail.org>\r
  65 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  66 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  67         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  68 X-List-Received-Date: Fri, 09 Mar 2012 23:13:21 -0000\r
  69 \r
  70 On Tue, 21 Feb 2012 23:46:39 -0700, Adam Wolfe Gordon <awg+notmuch@xvx.ca> wrote:\r
  71 > Use the new JSON reply format to create replies in emacs. Quote HTML\r
  72 > parts nicely by using mm-display-part to turn them into displayable\r
  73 > text, then quoting them with message-cite-original. This is very\r
  74 > useful for users who regularly receive HTML-only email.\r
  75 > \r
  76 > Use message-mode's message-cite-original function to create the\r
  77 > quoted body for reply messages. In order to make this act like the\r
  78 > existing notmuch defaults, you will need to set the following in\r
  79 > your emacs configuration:\r
  80 > \r
  81 > message-citation-line-format "On %a, %d %b %Y, %f wrote:"\r
  82 > message-citation-line-function 'message-insert-formatted-citation-line\r
  83 > \r
  84 > The tests have been updated to reflect the (ugly) emacs default.\r
  85 > ---\r
  86 >  emacs/notmuch-lib.el |   11 ++++\r
  87 >  emacs/notmuch-mua.el |  136 ++++++++++++++++++++++++++++++++++---------------\r
  88 >  test/emacs           |    8 ++--\r
  89 >  3 files changed, 109 insertions(+), 46 deletions(-)\r
  90 > \r
  91 > diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
  92 > index 7e3f110..8bac596 100644\r
  93 > --- a/emacs/notmuch-lib.el\r
  94 > +++ b/emacs/notmuch-lib.el\r
  95 > @@ -206,6 +206,17 @@ the user hasn't set this variable with the old or new value."\r
  96 >         (setq seq (nconc (delete elem seq) (list elem))))))\r
  97 >      seq))\r
  98 >  \r
  99 > +(defun notmuch-parts-filter-by-type (parts type)\r
 100 > +  "Given a list of message parts, return a list containing the ones matching\r
 101 > +the given type."\r
 102 > +  (remove-if-not\r
 103 > +   (lambda (part) (notmuch-match-content-type (plist-get part :content-type) type))\r
 104 > +   parts))\r
 105 > +\r
 106 > +(defun notmuch-plist-to-alist (plist)\r
 107 > +  (loop for (key value . rest) on plist by #'cddr\r
 108 > +     collect (cons (substring (symbol-name key) 1) value)))\r
 109 > +\r
 110 >  ;; Compatibility functions for versions of emacs before emacs 23.\r
 111 >  ;;\r
 112 >  ;; Both functions here were copied from emacs 23 with the following copyright:\r
 113 > diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el\r
 114 > index 4be7c13..5adf4d8 100644\r
 115 > --- a/emacs/notmuch-mua.el\r
 116 > +++ b/emacs/notmuch-mua.el\r
 117 > @@ -19,11 +19,15 @@\r
 118 >  ;;\r
 119 >  ;; Authors: David Edmondson <dme@dme.org>\r
 120 >  \r
 121 > +(require 'json)\r
 122 >  (require 'message)\r
 123 > +(require 'format-spec)\r
 124 >  \r
 125 >  (require 'notmuch-lib)\r
 126 >  (require 'notmuch-address)\r
 127 >  \r
 128 > +(eval-when-compile (require 'cl))\r
 129 > +\r
 130 >  ;;\r
 131 >  \r
 132 >  (defcustom notmuch-mua-send-hook '(notmuch-mua-message-send-hook)\r
 133 > @@ -72,56 +76,104 @@ list."\r
 134 >           (push header message-hidden-headers)))\r
 135 >       notmuch-mua-hidden-headers))\r
 136 >  \r
 137 > +(defun notmuch-mua-get-displayed-part (part query-string)\r
 138 > +  (with-temp-buffer\r
 139 > +    (if (plist-get part :content)\r
 140 > +     (insert (plist-get part :content))\r
 141 > +      (call-process notmuch-command nil t nil "show" "--format=raw"\r
 142 > +                 (format "--part=%s" (plist-get part :id))\r
 143 > +                 query-string))\r
 144 > +\r
 145 > +    (let ((handle (mm-make-handle (current-buffer) (list (plist-get part :content-type))))\r
 146 > +       (end-of-orig (point-max)))\r
 147 > +      (mm-display-part handle)\r
 148 > +      (delete-region (point-min) end-of-orig)\r
 149 > +      (buffer-substring (point-min) (point-max)))))\r
 150 > +\r
 151 > +(defun notmuch-mua-get-quotable-parts (parts)\r
 152 > +  (loop for part in parts\r
 153 > +     if (notmuch-match-content-type (plist-get part :content-type) "multipart/alternative")\r
 154 > +       collect (let* ((subparts (plist-get part :content))\r
 155 > +                     (types (mapcar (lambda (part) (plist-get part :content-type)) subparts))\r
 156 > +                     (chosen-type (car (notmuch-multipart/alternative-choose types))))\r
 157 > +                (loop for part in (reverse subparts)\r
 158 > +                      if (notmuch-match-content-type (plist-get part :content-type) chosen-type)\r
 159 > +                      return part))\r
 160 > +     else if (notmuch-match-content-type (plist-get part :content-type) "multipart/*")\r
 161 > +       append (notmuch-mua-get-quotable-parts (plist-get part :content))\r
 162 > +     else if (notmuch-match-content-type (plist-get part :content-type) "text/*")\r
 163 > +       collect part))\r
 164 > +\r
 165 >  (defun notmuch-mua-reply (query-string &optional sender reply-all)\r
 166 > -  (let (headers\r
 167 > -     body\r
 168 > -     (args '("reply")))\r
 169 > -    (if notmuch-show-process-crypto\r
 170 > -     (setq args (append args '("--decrypt"))))\r
 171 > +  (let ((args '("reply" "--format=json"))\r
 172 > +     (json-object-type 'plist)\r
 173 > +     (json-array-type 'list)\r
 174 > +     (json-false 'nil)\r
 175 > +     reply\r
 176 > +     original)\r
 177 > +    (when notmuch-show-process-crypto\r
 178 > +      (setq args (append args '("--decrypt"))))\r
 179 > +\r
 180 >      (if reply-all\r
 181 >       (setq args (append args '("--reply-to=all")))\r
 182 >        (setq args (append args '("--reply-to=sender"))))\r
 183 >      (setq args (append args (list query-string)))\r
 184 > -    ;; This make assumptions about the output of `notmuch reply', but\r
 185 > -    ;; really only that the headers come first followed by a blank\r
 186 > -    ;; line and then the body.\r
 187 > +\r
 188 > +    ;; Get the reply object as JSON, and parse it into an elisp object.\r
 189 >      (with-temp-buffer\r
 190 >        (apply 'call-process (append (list notmuch-command nil (list t t) nil) args))\r
 191 >        (goto-char (point-min))\r
 192 > -      (if (re-search-forward "^$" nil t)\r
 193 > -       (save-excursion\r
 194 > -         (save-restriction\r
 195 > -           (narrow-to-region (point-min) (point))\r
 196 > -           (goto-char (point-min))\r
 197 > -           (setq headers (mail-header-extract)))))\r
 198 > -      (forward-line 1)\r
 199 > -      (setq body (buffer-substring (point) (point-max))))\r
 200 > -    ;; If sender is non-nil, set the From: header to its value.\r
 201 > -    (when sender\r
 202 > -      (mail-header-set 'from sender headers))\r
 203 > -    (let\r
 204 > -     ;; Overlay the composition window on that being used to read\r
 205 > -     ;; the original message.\r
 206 > -     ((same-window-regexps '("\\*mail .*")))\r
 207 > -      (notmuch-mua-mail (mail-header 'to headers)\r
 208 > -                     (mail-header 'subject headers)\r
 209 > -                     (message-headers-to-generate headers t '(to subject))))\r
 210 > -    ;; insert the message body - but put it in front of the signature\r
 211 > -    ;; if one is present\r
 212 > -    (goto-char (point-max))\r
 213 > -    (if (re-search-backward message-signature-separator nil t)\r
 214 > +      (setq reply (json-read)))\r
 215 > +\r
 216 > +    ;; Extract the original message to simplify the following code.\r
 217 > +    (setq original (plist-get reply :original))\r
 218 > +\r
 219 > +    ;; Extract the headers of both the reply and the original message.\r
 220 > +    (let* ((original-headers (plist-get original :headers))\r
 221 > +        (reply-headers (plist-get reply :reply-headers)))\r
 222 > +\r
 223 > +      ;; If sender is non-nil, set the From: header to its value.\r
 224 > +      (when sender\r
 225 > +     (plist-put reply-headers :From sender))\r
 226 > +      (let\r
 227 > +       ;; Overlay the composition window on that being used to read\r
 228 > +       ;; the original message.\r
 229 > +       ((same-window-regexps '("\\*mail .*")))\r
 230 > +     (notmuch-mua-mail (plist-get reply-headers :To)\r
 231 > +                       (plist-get reply-headers :Subject)\r
 232 > +                       (notmuch-plist-to-alist reply-headers)))\r
 233 > +      ;; Insert the message body - but put it in front of the signature\r
 234 > +      ;; if one is present\r
 235 > +      (goto-char (point-max))\r
 236 > +      (if (re-search-backward message-signature-separator nil t)\r
 237 >         (forward-line -1)\r
 238 > -      (goto-char (point-max)))\r
 239 > -    (insert body)\r
 240 > -    (push-mark))\r
 241 > -  (set-buffer-modified-p nil)\r
 242 > -\r
 243 > +     (goto-char (point-max)))\r
 244 > +\r
 245 > +      (let ((from (plist-get original-headers :From))\r
 246 > +         (date (plist-get original-headers :Date))\r
 247 > +         (start (point)))\r
 248 > +\r
 249 > +     ;; message-cite-original constructs a citation line based on the From and Date\r
 250 > +     ;; headers of the original message, which are assumed to be in the buffer.\r
 251 > +     (insert "From: " from "\n")\r
 252 > +     (insert "Date: " date "\n\n")\r
 253 > +\r
 254 > +     ;; Get the parts of the original message that should be quoted; this includes\r
 255 > +     ;; all the text parts, except the non-preferred ones in a multipart/alternative.\r
 256 > +     (let ((quotable-parts (notmuch-mua-get-quotable-parts (plist-get original :body))))\r
 257 > +       (mapc (lambda (part)\r
 258 > +               (insert (notmuch-mua-get-displayed-part part query-string)))\r
 259 > +             quotable-parts))\r
 260 > +\r
 261 > +     (set-mark (point))\r
 262 > +     (goto-char start)\r
 263 > +     ;; Quote the original message according to the user's configured style.\r
 264 > +     (message-cite-original)\r
 265 > +     (goto-char (point-max)))))\r
 266 > +\r
 267 > +  (push-mark)\r
 268 >    (message-goto-body)\r
 269 > -  ;; Original message may contain (malicious) MML tags.  We must\r
 270 > -  ;; properly quote them in the reply.  Note that using `point-max'\r
 271 > -  ;; instead of `mark' here is wrong.  The buffer may include user's\r
 272 > -  ;; signature which should not be MML-quoted.\r
 273 > -  (mml-quote-region (point) (mark)))\r
 274 \r
 275 Is it okay to drop mml quoting? Why?\r
 276 \r
 277 BR,\r
 278 Jani.\r
 279 \r
 280 \r
 281 > +  (set-buffer-modified-p nil))\r
 282 >  \r
 283 >  (defun notmuch-mua-forward-message ()\r
 284 >    (message-forward)\r
 285 > @@ -147,7 +199,7 @@ OTHER-ARGS are passed through to `message-mail'."\r
 286 >        (when (not (string= "" user-agent))\r
 287 >       (push (cons "User-Agent" user-agent) other-headers))))\r
 288 >  \r
 289 > -  (unless (mail-header 'from other-headers)\r
 290 > +  (unless (mail-header 'From other-headers)\r
 291 >      (push (cons "From" (concat\r
 292 >                       (notmuch-user-name) " <" (notmuch-user-primary-email) ">")) other-headers))\r
 293 >  \r
 294 > @@ -210,7 +262,7 @@ the From: address first."\r
 295 >    (interactive "P")\r
 296 >    (let ((other-headers\r
 297 >        (when (or prompt-for-sender notmuch-always-prompt-for-sender)\r
 298 > -        (list (cons 'from (notmuch-mua-prompt-for-sender))))))\r
 299 > +        (list (cons 'From (notmuch-mua-prompt-for-sender))))))\r
 300 >      (notmuch-mua-mail nil nil other-headers)))\r
 301 >  \r
 302 >  (defun notmuch-mua-new-forward-message (&optional prompt-for-sender)\r
 303 > diff --git a/test/emacs b/test/emacs\r
 304 > index c3a75e9..a6786d4 100755\r
 305 > --- a/test/emacs\r
 306 > +++ b/test/emacs\r
 307 > @@ -268,13 +268,13 @@ Subject: Re: Testing message sent via SMTP\r
 308 >  In-Reply-To: <XXX>\r
 309 >  Fcc: $(pwd)/mail/sent\r
 310 >  --text follows this line--\r
 311 > -On 01 Jan 2000 12:00:00 -0000, Notmuch Test Suite <test_suite@notmuchmail.org> wrote:\r
 312 > +Notmuch Test Suite <test_suite@notmuchmail.org> writes:\r
 313 > +\r
 314 >  > This is a test that messages are sent via SMTP\r
 315 >  EOF\r
 316 >  test_expect_equal_file OUTPUT EXPECTED\r
 317 >  \r
 318 >  test_begin_subtest "Reply within emacs to a multipart/mixed message"\r
 319 > -test_subtest_known_broken\r
 320 >  test_emacs '(notmuch-show "id:20091118002059.067214ed@hikari")\r
 321 >               (notmuch-show-reply)\r
 322 >               (test-output)'\r
 323 > @@ -334,7 +334,6 @@ EOF\r
 324 >  test_expect_equal_file OUTPUT EXPECTED\r
 325 >  \r
 326 >  test_begin_subtest "Reply within emacs to a multipart/alternative message"\r
 327 > -test_subtest_known_broken\r
 328 >  test_emacs '(notmuch-show "id:cf0c4d610911171136h1713aa59w9cf9aa31f052ad0a@mail.gmail.com")\r
 329 >               (notmuch-show-reply)\r
 330 >               (test-output)'\r
 331 > @@ -385,7 +384,8 @@ Subject: Re: Quote MML tags in reply\r
 332 >  In-Reply-To: <test-emacs-mml-quoting@message.id>\r
 333 >  Fcc: ${MAIL_DIR}/sent\r
 334 >  --text follows this line--\r
 335 > -On Fri, 05 Jan 2001 15:43:57 +0000, Notmuch Test Suite <test_suite@notmuchmail.org> wrote:\r
 336 > +Notmuch Test Suite <test_suite@notmuchmail.org> writes:\r
 337 > +\r
 338 >  > <#!part disposition=inline>\r
 339 >  EOF\r
 340 >  test_expect_equal_file OUTPUT EXPECTED\r
 341 > -- \r
 342 > 1.7.5.4\r
 343 > \r
 344 > _______________________________________________\r
 345 > notmuch mailing list\r
 346 > notmuch@notmuchmail.org\r
 347 > http://notmuchmail.org/mailman/listinfo/notmuch\r