a3/fb567848279ba4735892baf8219d2514f18685

   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 6D7E7429E3B\r
   6         for <notmuch@notmuchmail.org>; Mon, 16 Jan 2012 10:14:01 -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 MRDtH1MDE+Xz for <notmuch@notmuchmail.org>;\r
  16         Mon, 16 Jan 2012 10:13:58 -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 2C285429E37\r
  19         for <notmuch@notmuchmail.org>; Mon, 16 Jan 2012 10:13:55 -0800 (PST)\r
  20 Received: from lb7f8hsrpno-svcs.dcs.int.inet (HELO pd7ml2no-ssvc.prod.shaw.ca)\r
  21         ([10.0.144.222])\r
  22         by pd7mo1no-svcs.prod.shaw.ca with ESMTP; 16 Jan 2012 11:13:54 -0700\r
  23 X-Cloudmark-SP-Filtered: true\r
  24 X-Cloudmark-SP-Result: v=1.1 cv=GZn8e3lTBEeJrlGK3+GUWyR5aYe1SJcDn5uEERMe9yQ=\r
  25         c=1 sm=1\r
  26         a=c49xHdtiGxwA:10 a=BLceEmwcHowA:10 a=yQp6g8lIsgqumF79BAsFDg==:17\r
  27         a=H4IEW4q-AAAA:8 a=7343-z1_AAAA:8 a=86icDZwsQ_n_ub3iSkQA:9\r
  28         a=y1tSvLtBuvtIwk-oUxMA:7 a=Kw4u8EAyA4wA:10 a=0c-eHkXYtrgA:10\r
  29         a=HpAAvcLHHh0Zw7uRqdWCyQ==:117\r
  30 Received: from unknown (HELO lagos.xvx.ca) ([96.52.216.56])\r
  31         by pd7ml2no-dmz.prod.shaw.ca with ESMTP; 16 Jan 2012 11:13:54 -0700\r
  32 Received: by lagos.xvx.ca (Postfix, from userid 1000)\r
  33         id 661458004208; Mon, 16 Jan 2012 11:13:54 -0700 (MST)\r
  34 From: Adam Wolfe Gordon <awg+notmuch@xvx.ca>\r
  35 To: notmuch@notmuchmail.org\r
  36 Subject: [PATCH v2 4/4] emacs: Use the new JSON reply format.\r
  37 Date: Mon, 16 Jan 2012 11:13:23 -0700\r
  38 Message-Id: <1326737603-21166-5-git-send-email-awg+notmuch@xvx.ca>\r
  39 X-Mailer: git-send-email 1.7.5.4\r
  40 In-Reply-To: <1326737603-21166-1-git-send-email-awg+notmuch@xvx.ca>\r
  41 References: <1326737603-21166-1-git-send-email-awg+notmuch@xvx.ca>\r
  42 X-BeenThere: notmuch@notmuchmail.org\r
  43 X-Mailman-Version: 2.1.13\r
  44 Precedence: list\r
  45 List-Id: "Use and development of the notmuch mail system."\r
  46         <notmuch.notmuchmail.org>\r
  47 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  48         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  49 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  50 List-Post: <mailto:notmuch@notmuchmail.org>\r
  51 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  52 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  53         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  54 X-List-Received-Date: Mon, 16 Jan 2012 18:14:02 -0000\r
  55 \r
  56 Using the new JSON reply format allows emacs to quote HTML\r
  57 parts nicely by using mm-display-part to turn them into displayable\r
  58 text, then quoting them. This is very useful for users who\r
  59 regularly receive HTML-only email.\r
  60 \r
  61 The behavior for messages that contain plain text parts should be\r
  62 unchanged, except that an additional quoted line is added to the end\r
  63 of the reply message.  The test has been updated to reflect this.\r
  64 ---\r
  65  emacs/notmuch-lib.el |    8 ++++\r
  66  emacs/notmuch-mua.el |   95 ++++++++++++++++++++++++++++++++-----------------\r
  67  test/emacs           |    1 +\r
  68  3 files changed, 71 insertions(+), 33 deletions(-)\r
  69 \r
  70 diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
  71 index 0f856bf..d4dd011 100644\r
  72 --- a/emacs/notmuch-lib.el\r
  73 +++ b/emacs/notmuch-lib.el\r
  74 @@ -127,6 +127,14 @@ the user hasn't set this variable with the old or new value."\r
  75    (list 'when (< emacs-major-version 23)\r
  76         form))\r
  77  \r
  78 +(defun find-parts (parts type)\r
  79 +  "Return a list of message parts with the given type"\r
  80 +  (delq nil (mapcar (lambda (part)\r
  81 +                     (if (string= (cdr (assq 'content-type part)) type)\r
  82 +                         (cdr (assq 'content part))))\r
  83 +                   parts)))\r
  84 +\r
  85 +\r
  86  ;; Compatibility functions for versions of emacs before emacs 23.\r
  87  ;;\r
  88  ;; Both functions here were copied from emacs 23 with the following copyright:\r
  89 diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el\r
  90 index d8ab822..b03c62c 100644\r
  91 --- a/emacs/notmuch-mua.el\r
  92 +++ b/emacs/notmuch-mua.el\r
  93 @@ -19,6 +19,7 @@\r
  94  ;;\r
  95  ;; Authors: David Edmondson <dme@dme.org>\r
  96  \r
  97 +(require 'json)\r
  98  (require 'message)\r
  99  \r
 100  (require 'notmuch-lib)\r
 101 @@ -71,50 +72,78 @@ list."\r
 102             (push header message-hidden-headers)))\r
 103         notmuch-mua-hidden-headers))\r
 104  \r
 105 +(defun notmuch-mua-insert-part-quoted (part)\r
 106 +  (save-restriction\r
 107 +    (narrow-to-region (point) (point))\r
 108 +    (insert part)\r
 109 +    (goto-char (point-min))\r
 110 +    (perform-replace "^" "> " nil t nil)\r
 111 +    (insert "\n")\r
 112 +    (set-buffer-modified-p nil)))\r
 113 +\r
 114 +(defun notmuch-mua-parse-html-part (part)\r
 115 +  (with-temp-buffer\r
 116 +    (insert part)\r
 117 +    (let ((handle (mm-make-handle (current-buffer) (list "text/html")))\r
 118 +         (end-of-orig (point-max)))\r
 119 +      (mm-display-part handle)\r
 120 +      (kill-region (point-min) end-of-orig)\r
 121 +      (fill-region (point-min) (point-max))\r
 122 +      (buffer-substring (point-min) (point-max)))))\r
 123 +\r
 124  (defun notmuch-mua-reply (query-string &optional sender reply-all)\r
 125 -  (let (headers\r
 126 -       body\r
 127 -       (args '("reply")))\r
 128 +  (let ((args '("reply" "--format=json"))\r
 129 +       reply\r
 130 +       body)\r
 131      (if notmuch-show-process-crypto\r
 132         (setq args (append args '("--decrypt"))))\r
 133      (if reply-all\r
 134         (setq args (append args '("--reply-to=all")))\r
 135        (setq args (append args '("--reply-to=sender"))))\r
 136      (setq args (append args (list query-string)))\r
 137 -    ;; This make assumptions about the output of `notmuch reply', but\r
 138 -    ;; really only that the headers come first followed by a blank\r
 139 -    ;; line and then the body.\r
 140 +    ;; Get the reply object as JSON, and parse it into an elisp object.\r
 141      (with-temp-buffer\r
 142        (apply 'call-process (append (list notmuch-command nil (list t t) nil) args))\r
 143        (goto-char (point-min))\r
 144 -      (if (re-search-forward "^$" nil t)\r
 145 -         (save-excursion\r
 146 -           (save-restriction\r
 147 -             (narrow-to-region (point-min) (point))\r
 148 -             (goto-char (point-min))\r
 149 -             (setq headers (mail-header-extract)))))\r
 150 -      (forward-line 1)\r
 151 -      (setq body (buffer-substring (point) (point-max))))\r
 152 -    ;; If sender is non-nil, set the From: header to its value.\r
 153 -    (when sender\r
 154 -      (mail-header-set 'from sender headers))\r
 155 -    (let\r
 156 -       ;; Overlay the composition window on that being used to read\r
 157 -       ;; the original message.\r
 158 -       ((same-window-regexps '("\\*mail .*")))\r
 159 -      (notmuch-mua-mail (mail-header 'to headers)\r
 160 -                       (mail-header 'subject headers)\r
 161 -                       (message-headers-to-generate headers t '(to subject))))\r
 162 -    ;; insert the message body - but put it in front of the signature\r
 163 -    ;; if one is present\r
 164 -    (goto-char (point-max))\r
 165 -    (if (re-search-backward message-signature-separator nil t)\r
 166 +      (setq reply (aref (json-read) 0)))\r
 167 +\r
 168 +    ;; Start with the prelude, based on the headers of the original message.\r
 169 +    (let* ((original (cdr (assq 'original reply)))\r
 170 +          (headers (cdr (assq 'headers (assq 'reply reply))))\r
 171 +          (original-headers (cdr (assq 'headers original)))\r
 172 +          (body-parts (cdr (assq 'body original)))\r
 173 +          (plain-parts (find-parts body-parts "text/plain"))\r
 174 +          (html-parts (find-parts body-parts "text/html")))\r
 175 +\r
 176 +      ;; If sender is non-nil, set the From: header to its value.\r
 177 +      (when sender\r
 178 +       (mail-header-set 'from sender headers))\r
 179 +      (let\r
 180 +         ;; Overlay the composition window on that being used to read\r
 181 +         ;; the original message.\r
 182 +         ((same-window-regexps '("\\*mail .*")))\r
 183 +       (notmuch-mua-mail (mail-header 'to headers)\r
 184 +                         (mail-header 'subject headers)\r
 185 +                         (message-headers-to-generate headers t '(to subject))))\r
 186 +      ;; insert the message body - but put it in front of the signature\r
 187 +      ;; if one is present\r
 188 +      (goto-char (point-max))\r
 189 +      (if (re-search-backward message-signature-separator nil t)\r
 190           (forward-line -1)\r
 191 -      (goto-char (point-max)))\r
 192 -    (insert body)\r
 193 -    (push-mark))\r
 194 -  (set-buffer-modified-p nil)\r
 195 -\r
 196 +       (goto-char (point-max)))\r
 197 +\r
 198 +      (insert (format "On %s, %s wrote:\n"\r
 199 +                     (cdr (assq 'date original-headers))\r
 200 +                     (cdr (assq 'from original-headers))))\r
 201 +          \r
 202 +\r
 203 +      (if (null plain-parts)\r
 204 +         (mapc (lambda (part) (notmuch-mua-insert-part-quoted (notmuch-mua-parse-html-part part))) html-parts)\r
 205 +       (mapc (lambda (part) (notmuch-mua-insert-part-quoted part)) plain-parts))\r
 206 +      \r
 207 +      (push-mark))\r
 208 +    (set-buffer-modified-p nil))\r
 209 +  \r
 210    (message-goto-body))\r
 211  \r
 212  (defun notmuch-mua-forward-message ()\r
 213 diff --git a/test/emacs b/test/emacs\r
 214 index ac47b16..4219917 100755\r
 215 --- a/test/emacs\r
 216 +++ b/test/emacs\r
 217 @@ -270,6 +270,7 @@ Fcc: $(pwd)/mail/sent\r
 218  --text follows this line--\r
 219  On 01 Jan 2000 12:00:00 -0000, Notmuch Test Suite <test_suite@notmuchmail.org> wrote:\r
 220  > This is a test that messages are sent via SMTP\r
 221 +> \r
 222  EOF\r
 223  test_expect_equal_file OUTPUT EXPECTED\r
 224  \r
 225 -- \r
 226 1.7.5.4\r
 227 \r