0f/83be18d1d5ced491539b372997bab9c8dc02d1

   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 5659040EF31\r
   6         for <notmuch@notmuchmail.org>; Sat,  7 Jan 2012 23:53:13 -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 npTN+rd56huI for <notmuch@notmuchmail.org>;\r
  16         Sat,  7 Jan 2012 23:53:11 -0800 (PST)\r
  17 Received: from idcmail-mo1so.shaw.ca (idcmail-mo1so.shaw.ca [24.71.223.10])\r
  18         by olra.theworths.org (Postfix) with ESMTP id 5919240A3B4\r
  19         for <notmuch@notmuchmail.org>; Sat,  7 Jan 2012 23:53:11 -0800 (PST)\r
  20 Received: from pd2ml1so-ssvc.prod.shaw.ca ([10.0.141.139])\r
  21         by pd2mo1so-svcs.prod.shaw.ca with ESMTP; 08 Jan 2012 00:53:11 -0700\r
  22 X-Cloudmark-SP-Filtered: true\r
  23 X-Cloudmark-SP-Result: v=1.1 cv=2TvZ7eE48NdEYeaL5Xf58dNzJU178UzT+2lxUZ5Mhss=\r
  24         c=1 sm=1\r
  25         a=riRlqzb88rMA:10 a=BLceEmwcHowA:10 a=yQp6g8lIsgqumF79BAsFDg==:17\r
  26         a=H4IEW4q-AAAA:8 a=7343-z1_AAAA:8 a=S3h8R8xMpjlGWVskdFoA:9\r
  27         a=OXBJ_bGCH-Qf7lw6QaIA:7 a=Kw4u8EAyA4wA:10 a=0c-eHkXYtrgA:10\r
  28         a=HpAAvcLHHh0Zw7uRqdWCyQ==:117\r
  29 Received: from unknown (HELO lagos.xvx.ca) ([96.52.216.56])\r
  30         by pd2ml1so-dmz.prod.shaw.ca with ESMTP; 08 Jan 2012 00:53:11 -0700\r
  31 Received: by lagos.xvx.ca (Postfix, from userid 1000)\r
  32         id DEC2F8004202; Sun,  8 Jan 2012 00:53:10 -0700 (MST)\r
  33 From: Adam Wolfe Gordon <awg+notmuch@xvx.ca>\r
  34 To: notmuch@notmuchmail.org,\r
  35         awg@xvx.ca\r
  36 Subject: [PATCH 4/4] emacs: Use the new JSON reply format.\r
  37 Date: Sun,  8 Jan 2012 00:52:42 -0700\r
  38 Message-Id: <1326009162-19524-5-git-send-email-awg+notmuch@xvx.ca>\r
  39 X-Mailer: git-send-email 1.7.5.4\r
  40 In-Reply-To: <1326009162-19524-1-git-send-email-awg+notmuch@xvx.ca>\r
  41 References: <1326009162-19524-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: Sun, 08 Jan 2012 07:53:13 -0000\r
  55 \r
  56 From: Adam Wolfe Gordon <awg@xvx.ca>\r
  57 \r
  58 Using the new JSON reply format allows emacs to quote HTML parts\r
  59 nicely by first parsing them with w3m, then quoting them. This is\r
  60 very useful for users who regularly receive HTML-only email.\r
  61 \r
  62 The behavior for messages that contain plain text parts should be\r
  63 unchanged, except that an additional quoted line is added to the end\r
  64 of the reply message.  The test has been updated to reflect this.\r
  65 ---\r
  66  emacs/notmuch-mua.el |   62 +++++++++++++++++++++++++++++++++++++++----------\r
  67  test/emacs           |    1 +\r
  68  2 files changed, 50 insertions(+), 13 deletions(-)\r
  69 \r
  70 diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el\r
  71 index 7114e48..7f894cb 100644\r
  72 --- a/emacs/notmuch-mua.el\r
  73 +++ b/emacs/notmuch-mua.el\r
  74 @@ -19,6 +19,7 @@\r
  75  ;;\r
  76  ;; Authors: David Edmondson <dme@dme.org>\r
  77  \r
  78 +(require 'json)\r
  79  (require 'message)\r
  80  \r
  81  (require 'notmuch-lib)\r
  82 @@ -71,27 +72,62 @@ list."\r
  83             (push header message-hidden-headers)))\r
  84         notmuch-mua-hidden-headers))\r
  85  \r
  86 +(defun w3m-region (start end)) ;; From `w3m.el'.\r
  87 +(defun notmuch-mua-quote-part (part)\r
  88 +  (with-temp-buffer\r
  89 +    (insert part)\r
  90 +    (message-mode)\r
  91 +    (fill-region (point-min) (point-max))\r
  92 +    (goto-char (point-min))\r
  93 +    (perform-replace "^" "> " nil t nil)\r
  94 +    (set-buffer-modified-p nil)\r
  95 +    (buffer-substring (point-min) (point-max))))\r
  96 +(defun notmuch-mua-parse-html-part (part)\r
  97 +  (with-temp-buffer\r
  98 +    (insert part)\r
  99 +    (w3m-region (point-min) (point-max))\r
 100 +    (set-buffer-modified-p nil)\r
 101 +    (buffer-substring (point-min) (point-max))))\r
 102  (defun notmuch-mua-reply (query-string &optional sender)\r
 103 -  (let (headers\r
 104 +  (let (reply\r
 105 +       original\r
 106 +       headers\r
 107         body\r
 108 -       (args '("reply")))\r
 109 +       (args '("reply" "--format=json")))\r
 110      (if notmuch-show-process-crypto\r
 111         (setq args (append args '("--decrypt"))))\r
 112      (setq args (append args (list query-string)))\r
 113 -    ;; This make assumptions about the output of `notmuch reply', but\r
 114 -    ;; really only that the headers come first followed by a blank\r
 115 -    ;; line and then the body.\r
 116 +    ;; Get the reply object as JSON, and parse it into an elisp object.\r
 117      (with-temp-buffer\r
 118        (apply 'call-process (append (list notmuch-command nil (list t t) nil) args))\r
 119        (goto-char (point-min))\r
 120 -      (if (re-search-forward "^$" nil t)\r
 121 -         (save-excursion\r
 122 -           (save-restriction\r
 123 -             (narrow-to-region (point-min) (point))\r
 124 -             (goto-char (point-min))\r
 125 -             (setq headers (mail-header-extract)))))\r
 126 -      (forward-line 1)\r
 127 -      (setq body (buffer-substring (point) (point-max))))\r
 128 +      (setq reply (aref (json-read) 0)))\r
 129 +\r
 130 +    ;; Get the list of headers\r
 131 +    (setq headers (cdr (assq 'headers (assq 'reply reply))))\r
 132 +    ;; Construct the body of the reply.\r
 133 +    (setq original (cdr (assq 'original reply)))\r
 134 +\r
 135 +    ;; Start with the prelude, based on the headers of the original message.\r
 136 +    (let ((original-headers (cdr (assq 'headers original))))\r
 137 +      (setq body (format "On %s, %s wrote:\n"\r
 138 +                        (cdr (assq 'date original-headers))\r
 139 +                        (cdr (assq 'from original-headers)))))\r
 140 +\r
 141 +    ;; Extract the body parts and construct a reasonable quoted body.\r
 142 +    (let* ((body-parts (cdr (assq 'body original)))\r
 143 +          (find-parts (lambda (type) (delq nil (mapcar (lambda (part)\r
 144 +                                                         (if (string= (cdr (assq 'content-type part)) type)\r
 145 +                                                             (cdr (assq 'content part))))\r
 146 +                                                       body-parts))))\r
 147 +          (plain-parts (apply find-parts '("text/plain")))\r
 148 +          (html-parts (apply find-parts '("text/html"))))\r
 149 +      \r
 150 +      (if (not (null plain-parts))\r
 151 +         (mapc (lambda (part) (setq body (concat body (notmuch-mua-quote-part part)))) plain-parts)\r
 152 +       (mapc (lambda (part) (setq body (concat body (notmuch-mua-quote-part (notmuch-mua-parse-html-part part))))) html-parts)))\r
 153 +    (setq body (concat body "\n"))\r
 154 +       \r
 155      ;; If sender is non-nil, set the From: header to its value.\r
 156      (when sender\r
 157        (mail-header-set 'from sender headers))\r
 158 diff --git a/test/emacs b/test/emacs\r
 159 index a06c223..fe501da 100755\r
 160 --- a/test/emacs\r
 161 +++ b/test/emacs\r
 162 @@ -270,6 +270,7 @@ Fcc: $(pwd)/mail/sent\r
 163  --text follows this line--\r
 164  On 01 Jan 2000 12:00:00 -0000, Notmuch Test Suite <test_suite@notmuchmail.org> wrote:\r
 165  > This is a test that messages are sent via SMTP\r
 166 +> \r
 167  EOF\r
 168  test_expect_equal_file OUTPUT EXPECTED\r
 169  \r
 170 -- \r
 171 1.7.5.4\r
 172 \r