e6/b5e3ab823911ffae05ba4e8e551aef1d4b05e0

   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 594F2431FBD\r
   6         for <notmuch@notmuchmail.org>; Thu, 19 Jan 2012 09:47:10 -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 OdPTMt1LaEL4 for <notmuch@notmuchmail.org>;\r
  16         Thu, 19 Jan 2012 09:47:08 -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 EC66B431FBC\r
  19         for <notmuch@notmuchmail.org>; Thu, 19 Jan 2012 09:47:06 -0800 (PST)\r
  20 Received: from pd2ml1so-ssvc.prod.shaw.ca ([10.0.141.139])\r
  21         by pd3mo1so-svcs.prod.shaw.ca with ESMTP; 19 Jan 2012 10:47:05 -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=P0KT-rxv0FoA:10 a=BLceEmwcHowA:10 a=yQp6g8lIsgqumF79BAsFDg==:17\r
  26         a=H4IEW4q-AAAA:8 a=Cau_B0zPb9X8FJSHhfwA:9 a=8b7b0oulBVEiTl3x1mAA:7\r
  27         a=Kw4u8EAyA4wA:10 a=HpAAvcLHHh0Zw7uRqdWCyQ==:117\r
  28 Received: from unknown (HELO lagos.xvx.ca) ([96.52.216.56])\r
  29         by pd2ml1so-dmz.prod.shaw.ca with ESMTP; 19 Jan 2012 10:47:05 -0700\r
  30 Received: by lagos.xvx.ca (Postfix, from userid 1000)\r
  31         id 2E0928004C49; Thu, 19 Jan 2012 10:47:04 -0700 (MST)\r
  32 From: Adam Wolfe Gordon <awg+notmuch@xvx.ca>\r
  33 To: notmuch@notmuchmail.org\r
  34 Subject: [PATCH v3 4/5] emacs: Use the new JSON reply format.\r
  35 Date: Thu, 19 Jan 2012 10:46:56 -0700\r
  36 Message-Id: <1326995217-27423-5-git-send-email-awg+notmuch@xvx.ca>\r
  37 X-Mailer: git-send-email 1.7.5.4\r
  38 In-Reply-To: <1326995217-27423-1-git-send-email-awg+notmuch@xvx.ca>\r
  39 References: <1326995217-27423-1-git-send-email-awg+notmuch@xvx.ca>\r
  40 X-BeenThere: notmuch@notmuchmail.org\r
  41 X-Mailman-Version: 2.1.13\r
  42 Precedence: list\r
  43 List-Id: "Use and development of the notmuch mail system."\r
  44         <notmuch.notmuchmail.org>\r
  45 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  46         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  47 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  48 List-Post: <mailto:notmuch@notmuchmail.org>\r
  49 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  50 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  51         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  52 X-List-Received-Date: Thu, 19 Jan 2012 17:47:10 -0000\r
  53 \r
  54 Using the new JSON reply format allows emacs to quote HTML\r
  55 parts nicely by using mm-display-part to turn them into displayable\r
  56 text, then quoting them. This is very useful for users who\r
  57 regularly receive HTML-only email.\r
  58 \r
  59 The behavior for messages that contain plain text parts should be\r
  60 unchanged.\r
  61 ---\r
  62  emacs/notmuch-lib.el |    8 ++++\r
  63  emacs/notmuch-mua.el |   95 +++++++++++++++++++++++++++++++++-----------------\r
  64  2 files changed, 71 insertions(+), 32 deletions(-)\r
  65 \r
  66 diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
  67 index 9242537..9863d69 100644\r
  68 --- a/emacs/notmuch-lib.el\r
  69 +++ b/emacs/notmuch-lib.el\r
  70 @@ -21,6 +21,8 @@\r
  71  \r
  72  ;; This is an part of an emacs-based interface to the notmuch mail system.\r
  73  \r
  74 +(eval-when-compile (require 'cl))\r
  75 +\r
  76  (defvar notmuch-command "notmuch"\r
  77    "Command to run the notmuch binary.")\r
  78  \r
  79 @@ -160,6 +162,12 @@ the user hasn't set this variable with the old or new value."\r
  80    (list 'when (< emacs-major-version 23)\r
  81         form))\r
  82  \r
  83 +(defun notmuch-parts-filter-by-type (parts type)\r
  84 +  "Return a list of message parts with the given type"\r
  85 +  (loop for part across parts\r
  86 +       if (string= (cdr (assq 'content-type part)) type)\r
  87 +       collect (cdr (assq 'content part))))\r
  88 +\r
  89  ;; Compatibility functions for versions of emacs before emacs 23.\r
  90  ;;\r
  91  ;; Both functions here were copied from emacs 23 with the following copyright:\r
  92 diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el\r
  93 index 023645e..5ae0ccf 100644\r
  94 --- a/emacs/notmuch-mua.el\r
  95 +++ b/emacs/notmuch-mua.el\r
  96 @@ -19,6 +19,7 @@\r
  97  ;;\r
  98  ;; Authors: David Edmondson <dme@dme.org>\r
  99  \r
 100 +(require 'json)\r
 101  (require 'message)\r
 102  \r
 103  (require 'notmuch-lib)\r
 104 @@ -72,49 +73,79 @@ list."\r
 105             (push header message-hidden-headers)))\r
 106         notmuch-mua-hidden-headers))\r
 107  \r
 108 +(defun notmuch-mua-insert-part-quoted (part)\r
 109 +  (let ((start (point))\r
 110 +       limit)\r
 111 +    (insert part)\r
 112 +    (setq limit (point-marker))\r
 113 +    (goto-char start)\r
 114 +    (while (re-search-forward "\\(^\\)[^$]" (marker-position limit) 0)\r
 115 +      (replace-match "> " nil nil nil 1))\r
 116 +    (set-buffer-modified-p nil)))\r
 117 +\r
 118 +(defun notmuch-mua-parse-html-part (part)\r
 119 +  (with-temp-buffer\r
 120 +    (insert part)\r
 121 +    (let ((handle (mm-make-handle (current-buffer) (list "text/html")))\r
 122 +         (end-of-orig (point-max)))\r
 123 +      (mm-display-part handle)\r
 124 +      (delete-region (point-min) end-of-orig)\r
 125 +      (fill-region (point-min) (point-max))\r
 126 +      (buffer-substring (point-min) (point-max)))))\r
 127 +\r
 128  (defun notmuch-mua-reply (query-string &optional sender reply-all)\r
 129 -  (let (headers\r
 130 -       body\r
 131 -       (args '("reply")))\r
 132 +  (let ((args '("reply" "--format=json"))\r
 133 +       reply\r
 134 +       body)\r
 135      (if notmuch-show-process-crypto\r
 136         (setq args (append args '("--decrypt"))))\r
 137      (if reply-all\r
 138         (setq args (append args '("--reply-to=all")))\r
 139        (setq args (append args '("--reply-to=sender"))))\r
 140      (setq args (append args (list query-string)))\r
 141 -    ;; This make assumptions about the output of `notmuch reply', but\r
 142 -    ;; really only that the headers come first followed by a blank\r
 143 -    ;; line and then the body.\r
 144 +    ;; Get the reply object as JSON, and parse it into an elisp object.\r
 145      (with-temp-buffer\r
 146        (apply 'call-process (append (list notmuch-command nil (list t t) nil) args))\r
 147        (goto-char (point-min))\r
 148 -      (if (re-search-forward "^$" nil t)\r
 149 -         (save-excursion\r
 150 -           (save-restriction\r
 151 -             (narrow-to-region (point-min) (point))\r
 152 -             (goto-char (point-min))\r
 153 -             (setq headers (mail-header-extract)))))\r
 154 -      (forward-line 1)\r
 155 -      (setq body (buffer-substring (point) (point-max))))\r
 156 -    ;; If sender is non-nil, set the From: header to its value.\r
 157 -    (when sender\r
 158 -      (mail-header-set 'from sender headers))\r
 159 -    (let\r
 160 -       ;; Overlay the composition window on that being used to read\r
 161 -       ;; the original message.\r
 162 -       ((same-window-regexps '("\\*mail .*")))\r
 163 -      (notmuch-mua-mail (mail-header 'to headers)\r
 164 -                       (mail-header 'subject headers)\r
 165 -                       (message-headers-to-generate headers t '(to subject))))\r
 166 -    ;; insert the message body - but put it in front of the signature\r
 167 -    ;; if one is present\r
 168 -    (goto-char (point-max))\r
 169 -    (if (re-search-backward message-signature-separator nil t)\r
 170 +      (setq reply (aref (json-read) 0)))\r
 171 +\r
 172 +    ;; Start with the prelude, based on the headers of the original message.\r
 173 +    (let* ((original (cdr (assq 'original reply)))\r
 174 +          (headers (cdr (assq 'headers (assq 'reply reply))))\r
 175 +          (original-headers (cdr (assq 'headers original)))\r
 176 +          (body-parts (cdr (assq 'body original)))\r
 177 +          (plain-parts (notmuch-parts-filter-by-type body-parts "text/plain"))\r
 178 +          (html-parts (notmuch-parts-filter-by-type body-parts "text/html")))\r
 179 +\r
 180 +      ;; If sender is non-nil, set the From: header to its value.\r
 181 +      (when sender\r
 182 +       (mail-header-set 'from sender headers))\r
 183 +      (let\r
 184 +         ;; Overlay the composition window on that being used to read\r
 185 +         ;; the original message.\r
 186 +         ((same-window-regexps '("\\*mail .*")))\r
 187 +       (notmuch-mua-mail (mail-header 'to headers)\r
 188 +                         (mail-header 'subject headers)\r
 189 +                         (message-headers-to-generate headers t '(to subject))))\r
 190 +      ;; insert the message body - but put it in front of the signature\r
 191 +      ;; if one is present\r
 192 +      (goto-char (point-max))\r
 193 +      (if (re-search-backward message-signature-separator nil t)\r
 194           (forward-line -1)\r
 195 -      (goto-char (point-max)))\r
 196 -    (insert body)\r
 197 -    (push-mark))\r
 198 -  (set-buffer-modified-p nil)\r
 199 +       (goto-char (point-max)))\r
 200 +\r
 201 +      (insert (format "On %s, %s wrote:\n"\r
 202 +                     (cdr (assq 'date original-headers))\r
 203 +                     (cdr (assq 'from original-headers))))\r
 204 +\r
 205 +      (if plain-parts\r
 206 +         (mapc (lambda (part) (notmuch-mua-insert-part-quoted part)) plain-parts)\r
 207 +       (mapc (lambda (part)\r
 208 +               (notmuch-mua-insert-part-quoted (notmuch-mua-parse-html-part part)))\r
 209 +             html-parts))\r
 210 +\r
 211 +      (push-mark))\r
 212 +    (set-buffer-modified-p nil))\r
 213  \r
 214    (message-goto-body))\r
 215  \r
 216 -- \r
 217 1.7.5.4\r
 218 \r