--- /dev/null
+Return-Path: <awg@lagos.xvx.ca>\r
+X-Original-To: notmuch@notmuchmail.org\r
+Delivered-To: notmuch@notmuchmail.org\r
+Received: from localhost (localhost [127.0.0.1])\r
+ by olra.theworths.org (Postfix) with ESMTP id 594F2431FBD\r
+ for <notmuch@notmuchmail.org>; Thu, 19 Jan 2012 09:47:10 -0800 (PST)\r
+X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
+X-Spam-Flag: NO\r
+X-Spam-Score: 0\r
+X-Spam-Level: \r
+X-Spam-Status: No, score=0 tagged_above=-999 required=5\r
+ tests=[RCVD_IN_DNSWL_NONE=-0.0001] autolearn=disabled\r
+Received: from olra.theworths.org ([127.0.0.1])\r
+ by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
+ with ESMTP id OdPTMt1LaEL4 for <notmuch@notmuchmail.org>;\r
+ Thu, 19 Jan 2012 09:47:08 -0800 (PST)\r
+Received: from idcmail-mo1so.shaw.ca (idcmail-mo1so.shaw.ca [24.71.223.10])\r
+ by olra.theworths.org (Postfix) with ESMTP id EC66B431FBC\r
+ for <notmuch@notmuchmail.org>; Thu, 19 Jan 2012 09:47:06 -0800 (PST)\r
+Received: from pd2ml1so-ssvc.prod.shaw.ca ([10.0.141.139])\r
+ by pd3mo1so-svcs.prod.shaw.ca with ESMTP; 19 Jan 2012 10:47:05 -0700\r
+X-Cloudmark-SP-Filtered: true\r
+X-Cloudmark-SP-Result: v=1.1 cv=2TvZ7eE48NdEYeaL5Xf58dNzJU178UzT+2lxUZ5Mhss=\r
+ c=1 sm=1\r
+ a=P0KT-rxv0FoA:10 a=BLceEmwcHowA:10 a=yQp6g8lIsgqumF79BAsFDg==:17\r
+ a=H4IEW4q-AAAA:8 a=Cau_B0zPb9X8FJSHhfwA:9 a=8b7b0oulBVEiTl3x1mAA:7\r
+ a=Kw4u8EAyA4wA:10 a=HpAAvcLHHh0Zw7uRqdWCyQ==:117\r
+Received: from unknown (HELO lagos.xvx.ca) ([96.52.216.56])\r
+ by pd2ml1so-dmz.prod.shaw.ca with ESMTP; 19 Jan 2012 10:47:05 -0700\r
+Received: by lagos.xvx.ca (Postfix, from userid 1000)\r
+ id 2E0928004C49; Thu, 19 Jan 2012 10:47:04 -0700 (MST)\r
+From: Adam Wolfe Gordon <awg+notmuch@xvx.ca>\r
+To: notmuch@notmuchmail.org\r
+Subject: [PATCH v3 4/5] emacs: Use the new JSON reply format.\r
+Date: Thu, 19 Jan 2012 10:46:56 -0700\r
+Message-Id: <1326995217-27423-5-git-send-email-awg+notmuch@xvx.ca>\r
+X-Mailer: git-send-email 1.7.5.4\r
+In-Reply-To: <1326995217-27423-1-git-send-email-awg+notmuch@xvx.ca>\r
+References: <1326995217-27423-1-git-send-email-awg+notmuch@xvx.ca>\r
+X-BeenThere: notmuch@notmuchmail.org\r
+X-Mailman-Version: 2.1.13\r
+Precedence: list\r
+List-Id: "Use and development of the notmuch mail system."\r
+ <notmuch.notmuchmail.org>\r
+List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
+List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
+List-Post: <mailto:notmuch@notmuchmail.org>\r
+List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
+List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
+X-List-Received-Date: Thu, 19 Jan 2012 17:47:10 -0000\r
+\r
+Using the new JSON reply format allows emacs to quote HTML\r
+parts nicely by using mm-display-part to turn them into displayable\r
+text, then quoting them. This is very useful for users who\r
+regularly receive HTML-only email.\r
+\r
+The behavior for messages that contain plain text parts should be\r
+unchanged.\r
+---\r
+ emacs/notmuch-lib.el | 8 ++++\r
+ emacs/notmuch-mua.el | 95 +++++++++++++++++++++++++++++++++-----------------\r
+ 2 files changed, 71 insertions(+), 32 deletions(-)\r
+\r
+diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
+index 9242537..9863d69 100644\r
+--- a/emacs/notmuch-lib.el\r
++++ b/emacs/notmuch-lib.el\r
+@@ -21,6 +21,8 @@\r
+ \r
+ ;; This is an part of an emacs-based interface to the notmuch mail system.\r
+ \r
++(eval-when-compile (require 'cl))\r
++\r
+ (defvar notmuch-command "notmuch"\r
+ "Command to run the notmuch binary.")\r
+ \r
+@@ -160,6 +162,12 @@ the user hasn't set this variable with the old or new value."\r
+ (list 'when (< emacs-major-version 23)\r
+ form))\r
+ \r
++(defun notmuch-parts-filter-by-type (parts type)\r
++ "Return a list of message parts with the given type"\r
++ (loop for part across parts\r
++ if (string= (cdr (assq 'content-type part)) type)\r
++ collect (cdr (assq 'content part))))\r
++\r
+ ;; Compatibility functions for versions of emacs before emacs 23.\r
+ ;;\r
+ ;; Both functions here were copied from emacs 23 with the following copyright:\r
+diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el\r
+index 023645e..5ae0ccf 100644\r
+--- a/emacs/notmuch-mua.el\r
++++ b/emacs/notmuch-mua.el\r
+@@ -19,6 +19,7 @@\r
+ ;;\r
+ ;; Authors: David Edmondson <dme@dme.org>\r
+ \r
++(require 'json)\r
+ (require 'message)\r
+ \r
+ (require 'notmuch-lib)\r
+@@ -72,49 +73,79 @@ list."\r
+ (push header message-hidden-headers)))\r
+ notmuch-mua-hidden-headers))\r
+ \r
++(defun notmuch-mua-insert-part-quoted (part)\r
++ (let ((start (point))\r
++ limit)\r
++ (insert part)\r
++ (setq limit (point-marker))\r
++ (goto-char start)\r
++ (while (re-search-forward "\\(^\\)[^$]" (marker-position limit) 0)\r
++ (replace-match "> " nil nil nil 1))\r
++ (set-buffer-modified-p nil)))\r
++\r
++(defun notmuch-mua-parse-html-part (part)\r
++ (with-temp-buffer\r
++ (insert part)\r
++ (let ((handle (mm-make-handle (current-buffer) (list "text/html")))\r
++ (end-of-orig (point-max)))\r
++ (mm-display-part handle)\r
++ (delete-region (point-min) end-of-orig)\r
++ (fill-region (point-min) (point-max))\r
++ (buffer-substring (point-min) (point-max)))))\r
++\r
+ (defun notmuch-mua-reply (query-string &optional sender reply-all)\r
+- (let (headers\r
+- body\r
+- (args '("reply")))\r
++ (let ((args '("reply" "--format=json"))\r
++ reply\r
++ body)\r
+ (if notmuch-show-process-crypto\r
+ (setq args (append args '("--decrypt"))))\r
+ (if reply-all\r
+ (setq args (append args '("--reply-to=all")))\r
+ (setq args (append args '("--reply-to=sender"))))\r
+ (setq args (append args (list query-string)))\r
+- ;; This make assumptions about the output of `notmuch reply', but\r
+- ;; really only that the headers come first followed by a blank\r
+- ;; line and then the body.\r
++ ;; Get the reply object as JSON, and parse it into an elisp object.\r
+ (with-temp-buffer\r
+ (apply 'call-process (append (list notmuch-command nil (list t t) nil) args))\r
+ (goto-char (point-min))\r
+- (if (re-search-forward "^$" nil t)\r
+- (save-excursion\r
+- (save-restriction\r
+- (narrow-to-region (point-min) (point))\r
+- (goto-char (point-min))\r
+- (setq headers (mail-header-extract)))))\r
+- (forward-line 1)\r
+- (setq body (buffer-substring (point) (point-max))))\r
+- ;; If sender is non-nil, set the From: header to its value.\r
+- (when sender\r
+- (mail-header-set 'from sender headers))\r
+- (let\r
+- ;; Overlay the composition window on that being used to read\r
+- ;; the original message.\r
+- ((same-window-regexps '("\\*mail .*")))\r
+- (notmuch-mua-mail (mail-header 'to headers)\r
+- (mail-header 'subject headers)\r
+- (message-headers-to-generate headers t '(to subject))))\r
+- ;; insert the message body - but put it in front of the signature\r
+- ;; if one is present\r
+- (goto-char (point-max))\r
+- (if (re-search-backward message-signature-separator nil t)\r
++ (setq reply (aref (json-read) 0)))\r
++\r
++ ;; Start with the prelude, based on the headers of the original message.\r
++ (let* ((original (cdr (assq 'original reply)))\r
++ (headers (cdr (assq 'headers (assq 'reply reply))))\r
++ (original-headers (cdr (assq 'headers original)))\r
++ (body-parts (cdr (assq 'body original)))\r
++ (plain-parts (notmuch-parts-filter-by-type body-parts "text/plain"))\r
++ (html-parts (notmuch-parts-filter-by-type body-parts "text/html")))\r
++\r
++ ;; If sender is non-nil, set the From: header to its value.\r
++ (when sender\r
++ (mail-header-set 'from sender headers))\r
++ (let\r
++ ;; Overlay the composition window on that being used to read\r
++ ;; the original message.\r
++ ((same-window-regexps '("\\*mail .*")))\r
++ (notmuch-mua-mail (mail-header 'to headers)\r
++ (mail-header 'subject headers)\r
++ (message-headers-to-generate headers t '(to subject))))\r
++ ;; insert the message body - but put it in front of the signature\r
++ ;; if one is present\r
++ (goto-char (point-max))\r
++ (if (re-search-backward message-signature-separator nil t)\r
+ (forward-line -1)\r
+- (goto-char (point-max)))\r
+- (insert body)\r
+- (push-mark))\r
+- (set-buffer-modified-p nil)\r
++ (goto-char (point-max)))\r
++\r
++ (insert (format "On %s, %s wrote:\n"\r
++ (cdr (assq 'date original-headers))\r
++ (cdr (assq 'from original-headers))))\r
++\r
++ (if plain-parts\r
++ (mapc (lambda (part) (notmuch-mua-insert-part-quoted part)) plain-parts)\r
++ (mapc (lambda (part)\r
++ (notmuch-mua-insert-part-quoted (notmuch-mua-parse-html-part part)))\r
++ html-parts))\r
++\r
++ (push-mark))\r
++ (set-buffer-modified-p nil))\r
+ \r
+ (message-goto-body))\r
+ \r
+-- \r
+1.7.5.4\r
+\r
projects / notmuch-archives.git / commitdiff