d1/32e25312d7bc0d348fe5cd5fbd50d2efc44450

   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 06F4241ED92\r
   6         for <notmuch@notmuchmail.org>; Wed, 15 Feb 2012 19:12:58 -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\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 0mBuM5jTZ4mF for <notmuch@notmuchmail.org>;\r
  16         Wed, 15 Feb 2012 19:12:54 -0800 (PST)\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 9DDCA429E4F\r
  19         for <notmuch@notmuchmail.org>; Wed, 15 Feb 2012 19:12:47 -0800 (PST)\r
  20 Received: from lb7f8hsrpno-svcs.dcs.int.inet (HELO pd6ml1no-ssvc.prod.shaw.ca)\r
  21         ([10.0.144.222])\r
  22         by pd6mo1no-svcs.prod.shaw.ca with ESMTP; 15 Feb 2012 20:12:47 -0700\r
  23 X-Cloudmark-SP-Filtered: true\r
  24 X-Cloudmark-SP-Result: v=1.1 cv=Cufqhujp69hR+MhiHu40yK/USb/hlYs0+irVU46A6+k=\r
  25         c=1 sm=1\r
  26         a=Z5iDYLMGwAcA:10 a=BLceEmwcHowA:10 a=yQp6g8lIsgqumF79BAsFDg==:17\r
  27         a=H4IEW4q-AAAA:8 a=7343-z1_AAAA:8 a=pGLkceISAAAA:8\r
  28         a=sW8ZUVT9fjtYQyWcCR4A:9\r
  29         a=dH1UOewsV4vhkg3hdfQA:7 a=0BPXsuqt4rsA:10 a=Kw4u8EAyA4wA:10\r
  30         a=0c-eHkXYtrgA:10 a=q9ffXd82REXWyX97:21 a=OF_rVAV-Bfowtp03:21\r
  31         a=HpAAvcLHHh0Zw7uRqdWCyQ==:117\r
  32 Received: from unknown (HELO lagos.xvx.ca) ([96.52.216.56])\r
  33         by pd6ml1no-dmz.prod.shaw.ca with ESMTP; 15 Feb 2012 20:12:46 -0700\r
  34 Received: by lagos.xvx.ca (Postfix, from userid 1000)\r
  35         id 40B318000D51; Wed, 15 Feb 2012 20:12:46 -0700 (MST)\r
  36 From: Adam Wolfe Gordon <awg+notmuch@xvx.ca>\r
  37 To: notmuch@notmuchmail.org\r
  38 Subject: [PATCH v5.2 7/7] emacs: Use the new JSON reply format and\r
  39         message-cite-original\r
  40 Date: Wed, 15 Feb 2012 20:12:37 -0700\r
  41 Message-Id: <1329361957-28493-8-git-send-email-awg+notmuch@xvx.ca>\r
  42 X-Mailer: git-send-email 1.7.5.4\r
  43 In-Reply-To: <1329361957-28493-1-git-send-email-awg+notmuch@xvx.ca>\r
  44 References: <1329361957-28493-1-git-send-email-awg+notmuch@xvx.ca>\r
  45 X-BeenThere: notmuch@notmuchmail.org\r
  46 X-Mailman-Version: 2.1.13\r
  47 Precedence: list\r
  48 List-Id: "Use and development of the notmuch mail system."\r
  49         <notmuch.notmuchmail.org>\r
  50 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  51         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  52 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  53 List-Post: <mailto:notmuch@notmuchmail.org>\r
  54 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  55 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  56         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  57 X-List-Received-Date: Thu, 16 Feb 2012 03:12:58 -0000\r
  58 \r
  59 Use the new JSON reply format to create replies in emacs. Quote HTML\r
  60 parts nicely by using mm-display-part to turn them into displayable\r
  61 text, then quoting them with message-cite-original. This is very\r
  62 useful for users who regularly receive HTML-only email.\r
  63 \r
  64 Use message-mode's message-cite-original function to create the\r
  65 quoted body for reply messages. In order to make this act like the\r
  66 existing notmuch defaults, you will need to set the following in\r
  67 your emacs configuration:\r
  68 \r
  69 message-citation-line-format "On %a, %d %b %Y, %f wrote:"\r
  70 message-citation-line-function 'message-insert-formatted-citation-line\r
  71 \r
  72 The tests have been updated to reflect the (ugly) emacs default.\r
  73 ---\r
  74  emacs/notmuch-lib.el |    6 ++\r
  75  emacs/notmuch-mua.el |  127 +++++++++++++++++++++++++++++++++++---------------\r
  76  test/emacs           |    8 ++--\r
  77  3 files changed, 100 insertions(+), 41 deletions(-)\r
  78 \r
  79 diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
  80 index 7e3f110..3fc7aff 100644\r
  81 --- a/emacs/notmuch-lib.el\r
  82 +++ b/emacs/notmuch-lib.el\r
  83 @@ -206,6 +206,12 @@ the user hasn't set this variable with the old or new value."\r
  84           (setq seq (nconc (delete elem seq) (list elem))))))\r
  85      seq))\r
  86  \r
  87 +(defun notmuch-parts-filter-by-type (parts type)\r
  88 +  "Given a vector of message parts, return a vector containing the ones matching the given type."\r
  89 +  (loop for part across parts\r
  90 +       if (notmuch-match-content-type (cdr (assq 'content-type part)) type)\r
  91 +       vconcat (list part)))\r
  92 +\r
  93  ;; Compatibility functions for versions of emacs before emacs 23.\r
  94  ;;\r
  95  ;; Both functions here were copied from emacs 23 with the following copyright:\r
  96 diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el\r
  97 index 4be7c13..7d43821 100644\r
  98 --- a/emacs/notmuch-mua.el\r
  99 +++ b/emacs/notmuch-mua.el\r
 100 @@ -19,11 +19,15 @@\r
 101  ;;\r
 102  ;; Authors: David Edmondson <dme@dme.org>\r
 103  \r
 104 +(require 'json)\r
 105  (require 'message)\r
 106 +(require 'format-spec)\r
 107  \r
 108  (require 'notmuch-lib)\r
 109  (require 'notmuch-address)\r
 110  \r
 111 +(eval-when-compile (require 'cl))\r
 112 +\r
 113  ;;\r
 114  \r
 115  (defcustom notmuch-mua-send-hook '(notmuch-mua-message-send-hook)\r
 116 @@ -72,56 +76,105 @@ list."\r
 117             (push header message-hidden-headers)))\r
 118         notmuch-mua-hidden-headers))\r
 119  \r
 120 +(defun notmuch-mua-get-displayed-part (part query-string)\r
 121 +  (with-temp-buffer\r
 122 +    (if (assq 'content part)\r
 123 +       (insert (cdr (assq 'content part)))\r
 124 +      (call-process notmuch-command nil t nil "show" "--format=raw"\r
 125 +                   (format "--part=%s" (cdr (assq 'id part)))\r
 126 +                   query-string))\r
 127 +\r
 128 +    (let ((handle (mm-make-handle (current-buffer) (list (cdr (assq 'content-type part)))))\r
 129 +         (end-of-orig (point-max)))\r
 130 +      (mm-display-part handle)\r
 131 +      (delete-region (point-min) end-of-orig)\r
 132 +      (buffer-substring (point-min) (point-max)))))\r
 133 +\r
 134 +(defun notmuch-mua-multipart/*-to-list (parts)\r
 135 +  (loop for part across parts\r
 136 +       collect (cdr (assq 'content-type part))))\r
 137 +\r
 138 +(defun notmuch-mua-get-quotable-parts (parts)\r
 139 +  (loop for part across parts\r
 140 +       if (notmuch-match-content-type (cdr (assq 'content-type part)) "multipart/alternative")\r
 141 +         append (let* ((subparts (cdr (assq 'content part)))\r
 142 +                       (types (notmuch-mua-multipart/*-to-list subparts))\r
 143 +                       (chosen-type (car (notmuch-multipart/alternative-choose types))))\r
 144 +                  (notmuch-mua-get-quotable-parts (notmuch-parts-filter-by-type subparts chosen-type)))\r
 145 +       else if (notmuch-match-content-type (cdr (assq 'content-type part)) "multipart/*")\r
 146 +         append (notmuch-mua-get-quotable-parts (cdr (assq 'content part)))\r
 147 +       else if (notmuch-match-content-type (cdr (assq 'content-type part)) "text/*")\r
 148 +         collect part))\r
 149 +\r
 150  (defun notmuch-mua-reply (query-string &optional sender reply-all)\r
 151 -  (let (headers\r
 152 -       body\r
 153 -       (args '("reply")))\r
 154 -    (if notmuch-show-process-crypto\r
 155 -       (setq args (append args '("--decrypt"))))\r
 156 +  (let ((args '("reply" "--format=json"))\r
 157 +       reply\r
 158 +       original)\r
 159 +    (when notmuch-show-process-crypto\r
 160 +      (setq args (append args '("--decrypt"))))\r
 161 +\r
 162      (if reply-all\r
 163         (setq args (append args '("--reply-to=all")))\r
 164        (setq args (append args '("--reply-to=sender"))))\r
 165      (setq args (append args (list query-string)))\r
 166 -    ;; This make assumptions about the output of `notmuch reply', but\r
 167 -    ;; really only that the headers come first followed by a blank\r
 168 -    ;; line and then the body.\r
 169 +\r
 170 +    ;; Get the reply object as JSON, and parse it into an elisp object.\r
 171      (with-temp-buffer\r
 172        (apply 'call-process (append (list notmuch-command nil (list t t) nil) args))\r
 173        (goto-char (point-min))\r
 174 -      (if (re-search-forward "^$" nil t)\r
 175 -         (save-excursion\r
 176 -           (save-restriction\r
 177 -             (narrow-to-region (point-min) (point))\r
 178 -             (goto-char (point-min))\r
 179 -             (setq headers (mail-header-extract)))))\r
 180 -      (forward-line 1)\r
 181 -      (setq body (buffer-substring (point) (point-max))))\r
 182 -    ;; If sender is non-nil, set the From: header to its value.\r
 183 -    (when sender\r
 184 -      (mail-header-set 'from sender headers))\r
 185 -    (let\r
 186 -       ;; Overlay the composition window on that being used to read\r
 187 -       ;; the original message.\r
 188 -       ((same-window-regexps '("\\*mail .*")))\r
 189 -      (notmuch-mua-mail (mail-header 'to headers)\r
 190 -                       (mail-header 'subject headers)\r
 191 -                       (message-headers-to-generate headers t '(to subject))))\r
 192 -    ;; insert the message body - but put it in front of the signature\r
 193 -    ;; if one is present\r
 194 -    (goto-char (point-max))\r
 195 -    (if (re-search-backward message-signature-separator nil t)\r
 196 +      (setq reply (json-read)))\r
 197 +\r
 198 +    ;; Extract the original message to simplify the following code.\r
 199 +    (setq original (cdr (assq 'original reply)))\r
 200 +\r
 201 +    ;; Extract the headers of both the reply and the original message.\r
 202 +    (let* ((original-headers (cdr (assq 'headers original)))\r
 203 +          (reply-headers (cdr (assq 'reply-headers reply))))\r
 204 +\r
 205 +      ;; If sender is non-nil, set the From: header to its value.\r
 206 +      (when sender\r
 207 +       (mail-header-set 'From sender reply-headers))\r
 208 +      (let\r
 209 +         ;; Overlay the composition window on that being used to read\r
 210 +         ;; the original message.\r
 211 +         ((same-window-regexps '("\\*mail .*")))\r
 212 +       (notmuch-mua-mail (mail-header 'To reply-headers)\r
 213 +                         (mail-header 'Subject reply-headers)\r
 214 +                         (message-headers-to-generate reply-headers t '(To Subject))))\r
 215 +      ;; Insert the message body - but put it in front of the signature\r
 216 +      ;; if one is present\r
 217 +      (goto-char (point-max))\r
 218 +      (if (re-search-backward message-signature-separator nil t)\r
 219           (forward-line -1)\r
 220 -      (goto-char (point-max)))\r
 221 -    (insert body)\r
 222 -    (push-mark))\r
 223 -  (set-buffer-modified-p nil)\r
 224 +       (goto-char (point-max)))\r
 225 +\r
 226 +      (let ((from (cdr (assq 'From original-headers)))\r
 227 +           (date (cdr (assq 'Date original-headers)))\r
 228 +           (start (point)))\r
 229 +\r
 230 +       (insert "From: " from "\n")\r
 231 +       (insert "Date: " date "\n\n")\r
 232 +\r
 233 +       ;; Get the parts of the original message that should be quoted; this includes\r
 234 +       ;; all the text parts, except the non-preferred ones in a multipart/alternative.\r
 235 +       (let ((quotable-parts (notmuch-mua-get-quotable-parts (cdr (assq 'body original)))))\r
 236 +         (mapc (lambda (part)\r
 237 +                 (insert (notmuch-mua-get-displayed-part part query-string)))\r
 238 +               quotable-parts))\r
 239 +\r
 240 +       (push-mark)\r
 241 +       (goto-char start)\r
 242 +       ;; Quote the original message according to the user's configured style.\r
 243 +       (message-cite-original))))\r
 244  \r
 245 +  (push-mark)\r
 246    (message-goto-body)\r
 247    ;; Original message may contain (malicious) MML tags.  We must\r
 248    ;; properly quote them in the reply.  Note that using `point-max'\r
 249    ;; instead of `mark' here is wrong.  The buffer may include user's\r
 250    ;; signature which should not be MML-quoted.\r
 251 -  (mml-quote-region (point) (mark)))\r
 252 +  (mml-quote-region (point) (mark))\r
 253 +  (set-buffer-modified-p nil))\r
 254  \r
 255  (defun notmuch-mua-forward-message ()\r
 256    (message-forward)\r
 257 @@ -147,7 +200,7 @@ OTHER-ARGS are passed through to `message-mail'."\r
 258        (when (not (string= "" user-agent))\r
 259         (push (cons "User-Agent" user-agent) other-headers))))\r
 260  \r
 261 -  (unless (mail-header 'from other-headers)\r
 262 +  (unless (mail-header 'From other-headers)\r
 263      (push (cons "From" (concat\r
 264                         (notmuch-user-name) " <" (notmuch-user-primary-email) ">")) other-headers))\r
 265  \r
 266 @@ -210,7 +263,7 @@ the From: address first."\r
 267    (interactive "P")\r
 268    (let ((other-headers\r
 269          (when (or prompt-for-sender notmuch-always-prompt-for-sender)\r
 270 -          (list (cons 'from (notmuch-mua-prompt-for-sender))))))\r
 271 +          (list (cons 'From (notmuch-mua-prompt-for-sender))))))\r
 272      (notmuch-mua-mail nil nil other-headers)))\r
 273  \r
 274  (defun notmuch-mua-new-forward-message (&optional prompt-for-sender)\r
 275 diff --git a/test/emacs b/test/emacs\r
 276 index c3a75e9..a6786d4 100755\r
 277 --- a/test/emacs\r
 278 +++ b/test/emacs\r
 279 @@ -268,13 +268,13 @@ Subject: Re: Testing message sent via SMTP\r
 280  In-Reply-To: <XXX>\r
 281  Fcc: $(pwd)/mail/sent\r
 282  --text follows this line--\r
 283 -On 01 Jan 2000 12:00:00 -0000, Notmuch Test Suite <test_suite@notmuchmail.org> wrote:\r
 284 +Notmuch Test Suite <test_suite@notmuchmail.org> writes:\r
 285 +\r
 286  > This is a test that messages are sent via SMTP\r
 287  EOF\r
 288  test_expect_equal_file OUTPUT EXPECTED\r
 289  \r
 290  test_begin_subtest "Reply within emacs to a multipart/mixed message"\r
 291 -test_subtest_known_broken\r
 292  test_emacs '(notmuch-show "id:20091118002059.067214ed@hikari")\r
 293                 (notmuch-show-reply)\r
 294                 (test-output)'\r
 295 @@ -334,7 +334,6 @@ EOF\r
 296  test_expect_equal_file OUTPUT EXPECTED\r
 297  \r
 298  test_begin_subtest "Reply within emacs to a multipart/alternative message"\r
 299 -test_subtest_known_broken\r
 300  test_emacs '(notmuch-show "id:cf0c4d610911171136h1713aa59w9cf9aa31f052ad0a@mail.gmail.com")\r
 301                 (notmuch-show-reply)\r
 302                 (test-output)'\r
 303 @@ -385,7 +384,8 @@ Subject: Re: Quote MML tags in reply\r
 304  In-Reply-To: <test-emacs-mml-quoting@message.id>\r
 305  Fcc: ${MAIL_DIR}/sent\r
 306  --text follows this line--\r
 307 -On Fri, 05 Jan 2001 15:43:57 +0000, Notmuch Test Suite <test_suite@notmuchmail.org> wrote:\r
 308 +Notmuch Test Suite <test_suite@notmuchmail.org> writes:\r
 309 +\r
 310  > <#!part disposition=inline>\r
 311  EOF\r
 312  test_expect_equal_file OUTPUT EXPECTED\r
 313 -- \r
 314 1.7.5.4\r
 315 \r