From 643ce61c1babf6e73ca7e03fb907282e7ee3b176 Mon Sep 17 00:00:00 2001
From: Pieter Praet <pieter@praet.org>
Date: Mon, 16 Jan 2012 11:38:33 +0100
Subject: emacs: logically group def{custom,face}s

To allow for expansion whilst keeping everything tidy and organized,
move all defcustom/defface variables to the following subgroups,
defined in notmuch-lib.el:

- Hello
- Search
- Show
- Send
- Crypto
- Hooks
- External Commands
- Appearance

As an added benefit, defcustom keyword args are now consistently
ordered as they appear @ defcustom's docstring (OCD much?).

Proper defgroup docstrings and various other improvements
by courtesy of Austin Clements.
---
 emacs/notmuch-lib.el | 37 +++++++++++++++++++++++++++++++++++--
 1 file changed, 35 insertions(+), 2 deletions(-)

(limited to 'emacs/notmuch-lib.el')

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 0f856bf..9242537 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -28,17 +28,50 @@
   "Notmuch mail reader for Emacs."
   :group 'mail)
 
+(defgroup notmuch-hello nil
+  "Overview of saved searches, tags, etc."
+  :group 'notmuch)
+
+(defgroup notmuch-search nil
+  "Searching and sorting mail."
+  :group 'notmuch)
+
+(defgroup notmuch-show nil
+  "Showing messages and threads."
+  :group 'notmuch)
+
+(defgroup notmuch-send nil
+  "Sending messages from Notmuch."
+  :group 'notmuch
+  :group 'message)
+
+(defgroup notmuch-crypto nil
+  "Processing and display of cryptographic MIME parts."
+  :group 'notmuch)
+
+(defgroup notmuch-hooks nil
+  "Running custom code on well-defined occasions."
+  :group 'notmuch)
+
+(defgroup notmuch-external nil
+  "Running external commands from within Notmuch."
+  :group 'notmuch)
+
+(defgroup notmuch-faces nil
+  "Graphical attributes for displaying text"
+  :group 'notmuch)
+
 (defcustom notmuch-search-oldest-first t
   "Show the oldest mail first when searching."
   :type 'boolean
-  :group 'notmuch)
+  :group 'notmuch-search)
 
 ;;
 
 (defcustom notmuch-saved-searches nil
   "A list of saved searches to display."
   :type '(alist :key-type string :value-type string)
-  :group 'notmuch)
+  :group 'notmuch-hello)
 
 (defvar notmuch-folders nil
   "Deprecated name for what is now known as `notmuch-saved-searches'.")
-- 
cgit v1.2.3


From 3a602dc27aa7a830c0bf00838dfdbb70165858d5 Mon Sep 17 00:00:00 2001
From: Pieter Praet <pieter@praet.org>
Date: Thu, 19 Jan 2012 20:13:05 +0100
Subject: emacs: invert relation between 'notmuch-send and 'message
 customization groups

'message contains options relevant to 'notmuch-send, not the other way around.

Thanks to Austin for suggesting `custom-add-to-group'.
  id:"20120118184408.GD16740@mit.edu"
---
 emacs/notmuch-lib.el | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

(limited to 'emacs/notmuch-lib.el')

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 9242537..e33e69a 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -42,8 +42,9 @@
 
 (defgroup notmuch-send nil
   "Sending messages from Notmuch."
-  :group 'notmuch
-  :group 'message)
+  :group 'notmuch)
+
+(custom-add-to-group 'notmuch-send 'message 'custom-group)
 
 (defgroup notmuch-crypto nil
   "Processing and display of cryptographic MIME parts."
-- 
cgit v1.2.3


From 37dec7d7b37afd281f23c0ec7ed9111c24965126 Mon Sep 17 00:00:00 2001
From: Tomi Ollila <tomi.ollila@iki.fi>
Date: Sat, 21 Jan 2012 16:44:28 +0200
Subject: emacs/*.el: changed one-char comment prefix ';' to two; ';;'

In order for emacs (indent-region) to (re)indent emacs lisp
properly there needs to be at least 2 comment characters (;;).
---
 emacs/notmuch-hello.el |   4 +-
 emacs/notmuch-lib.el   |  16 +++----
 emacs/notmuch-show.el  |  16 +++----
 emacs/notmuch.el       | 120 ++++++++++++++++++++++++-------------------------
 4 files changed, 78 insertions(+), 78 deletions(-)

(limited to 'emacs/notmuch-lib.el')

diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el
index 1a61768..63f2e07 100644
--- a/emacs/notmuch-hello.el
+++ b/emacs/notmuch-hello.el
@@ -402,8 +402,8 @@ Complete list of currently available key bindings:
   "Run notmuch and display saved searches, known tags, etc."
   (interactive)
 
-  ; Jump through a hoop to get this value from the deprecated variable
-  ; name (`notmuch-folders') or from the default value.
+  ;; Jump through a hoop to get this value from the deprecated variable
+  ;; name (`notmuch-folders') or from the default value.
   (unless notmuch-saved-searches
     (setq notmuch-saved-searches (notmuch-saved-searches)))
 
diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index e33e69a..241fe8c 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -148,14 +148,14 @@ the user hasn't set this variable with the old or new value."
       (setq list (cdr list)))
     (nreverse out)))
 
-; This lets us avoid compiling these replacement functions when emacs
-; is sufficiently new enough to supply them alone. We do the macro
-; treatment rather than just wrapping our defun calls in a when form
-; specifically so that the compiler never sees the code on new emacs,
-; (since the code is triggering warnings that we don't know how to get
-; rid of.
-;
-; A more clever macro here would accept a condition and a list of forms.
+;; This lets us avoid compiling these replacement functions when emacs
+;; is sufficiently new enough to supply them alone. We do the macro
+;; treatment rather than just wrapping our defun calls in a when form
+;; specifically so that the compiler never sees the code on new emacs,
+;; (since the code is triggering warnings that we don't know how to get
+;; rid of.
+;;
+;; A more clever macro here would accept a condition and a list of forms.
 (defmacro compile-on-emacs-prior-to-23 (form)
   "Conditionally evaluate form only on emacs < emacs-23."
   (list 'when (< emacs-major-version 23)
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 3fb13ab..e6a5b31 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -137,14 +137,14 @@ indentation."
   "Use external viewers to view all attachments from the current message."
   (interactive)
   (with-current-notmuch-show-message
-   ; We override the mm-inline-media-tests to indicate which message
-   ; parts are already sufficiently handled by the original
-   ; presentation of the message in notmuch-show mode. These parts
-   ; will be inserted directly into the temporary buffer of
-   ; with-current-notmuch-show-message and silently discarded.
-   ;
-   ; Any MIME part not explicitly mentioned here will be handled by an
-   ; external viewer as configured in the various mailcap files.
+   ;; We override the mm-inline-media-tests to indicate which message
+   ;; parts are already sufficiently handled by the original
+   ;; presentation of the message in notmuch-show mode. These parts
+   ;; will be inserted directly into the temporary buffer of
+   ;; with-current-notmuch-show-message and silently discarded.
+   ;;
+   ;; Any MIME part not explicitly mentioned here will be handled by an
+   ;; external viewer as configured in the various mailcap files.
    (let ((mm-inline-media-tests '(
 				  ("text/.*" ignore identity)
 				  ("application/pgp-signature" ignore identity)
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index da75faf..6b2c252 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -1,51 +1,51 @@
-; notmuch.el --- run notmuch within emacs
-;
-; Copyright © Carl Worth
-;
-; This file is part of Notmuch.
-;
-; Notmuch is free software: you can redistribute it and/or modify it
-; under the terms of the GNU General Public License as published by
-; the Free Software Foundation, either version 3 of the License, or
-; (at your option) any later version.
-;
-; Notmuch is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of
-; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-; General Public License for more details.
-;
-; You should have received a copy of the GNU General Public License
-; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.
-;
-; Authors: Carl Worth <cworth@cworth.org>
-
-; This is an emacs-based interface to the notmuch mail system.
-;
-; You will first need to have the notmuch program installed and have a
-; notmuch database built in order to use this. See
-; http://notmuchmail.org for details.
-;
-; To install this software, copy it to a directory that is on the
-; `load-path' variable within emacs (a good candidate is
-; /usr/local/share/emacs/site-lisp). If you are viewing this from the
-; notmuch source distribution then you can simply run:
-;
-;	sudo make install-emacs
-;
-; to install it.
-;
-; Then, to actually run it, add:
-;
-;	(require 'notmuch)
-;
-; to your ~/.emacs file, and then run "M-x notmuch" from within emacs,
-; or run:
-;
-;	emacs -f notmuch
-;
-; Have fun, and let us know if you have any comment, questions, or
-; kudos: Notmuch list <notmuch@notmuchmail.org> (subscription is not
-; required, but is available from http://notmuchmail.org).
+;; notmuch.el --- run notmuch within emacs
+;;
+;; Copyright © Carl Worth
+;;
+;; This file is part of Notmuch.
+;;
+;; Notmuch is free software: you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; Notmuch is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;; Authors: Carl Worth <cworth@cworth.org>
+
+;; This is an emacs-based interface to the notmuch mail system.
+;;
+;; You will first need to have the notmuch program installed and have a
+;; notmuch database built in order to use this. See
+;; http://notmuchmail.org for details.
+;;
+;; To install this software, copy it to a directory that is on the
+;; `load-path' variable within emacs (a good candidate is
+;; /usr/local/share/emacs/site-lisp). If you are viewing this from the
+;; notmuch source distribution then you can simply run:
+;;
+;;	sudo make install-emacs
+;;
+;; to install it.
+;;
+;; Then, to actually run it, add:
+;;
+;;	(require 'notmuch)
+;;
+;; to your ~/.emacs file, and then run "M-x notmuch" from within emacs,
+;; or run:
+;;
+;;	emacs -f notmuch
+;;
+;; Have fun, and let us know if you have any comment, questions, or
+;; kudos: Notmuch list <notmuch@notmuchmail.org> (subscription is not
+;; required, but is available from http://notmuchmail.org).
 
 (eval-when-compile (require 'cl))
 (require 'mm-view)
@@ -139,10 +139,10 @@ This is basically just `format-kbd-macro' but we also convert ESC to M-."
 	"M-"
       (concat desc " "))))
 
-; I would think that emacs would have code handy for walking a keymap
-; and generating strings for each key, and I would prefer to just call
-; that. But I couldn't find any (could be all implemented in C I
-; suppose), so I wrote my own here.
+;; I would think that emacs would have code handy for walking a keymap
+;; and generating strings for each key, and I would prefer to just call
+;; that. But I couldn't find any (could be all implemented in C I
+;; suppose), so I wrote my own here.
 (defun notmuch-substitute-one-command-key-with-prefix (prefix binding)
   "For a key binding, return a string showing a human-readable
 representation of the prefixed key as well as the first line of
@@ -271,14 +271,14 @@ For a mouse binding, return nil."
 (defun notmuch-search-scroll-down ()
   "Move backward through the search results by one window's worth."
   (interactive)
-  ; I don't know why scroll-down doesn't signal beginning-of-buffer
-  ; the way that scroll-up signals end-of-buffer, but c'est la vie.
-  ;
-  ; So instead of trapping a signal we instead check whether the
-  ; window begins on the first line of the buffer and if so, move
-  ; directly to that position. (We have to count lines since the
-  ; window-start position is not the same as point-min due to the
-  ; invisible thread-ID characters on the first line.
+  ;; I don't know why scroll-down doesn't signal beginning-of-buffer
+  ;; the way that scroll-up signals end-of-buffer, but c'est la vie.
+  ;;
+  ;; So instead of trapping a signal we instead check whether the
+  ;; window begins on the first line of the buffer and if so, move
+  ;; directly to that position. (We have to count lines since the
+  ;; window-start position is not the same as point-min due to the
+  ;; invisible thread-ID characters on the first line.
   (if (equal (count-lines (point-min) (window-start)) 0)
       (goto-char (point-min))
     (scroll-down nil)))
-- 
cgit v1.2.3


From bc267b70b01c79f6bdda52641e9cd7574a151eff Mon Sep 17 00:00:00 2001
From: Dmitry Kurochkin <dmitry.kurochkin@gmail.com>
Date: Wed, 25 Jan 2012 05:10:53 +0400
Subject: emacs: use a single history for all searches

There are two ways to do search in Emacs UI: search widget in
notmuch-hello buffer and `notmuch-search' function bound to "s".
Before the change, these search mechanisms used different history
lists.  The patch makes notmuch-hello search use the same history list
as `notmuch-search' function.
---
 emacs/notmuch-hello.el | 47 +++++++++++++++++++----------------------------
 emacs/notmuch-lib.el   |  3 +++
 emacs/notmuch.el       | 16 ++++++++++------
 3 files changed, 32 insertions(+), 34 deletions(-)

(limited to 'emacs/notmuch-lib.el')

diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el
index d88a870..6970bc3 100644
--- a/emacs/notmuch-hello.el
+++ b/emacs/notmuch-hello.el
@@ -29,8 +29,8 @@
 (declare-function notmuch-search "notmuch" (query &optional oldest-first target-thread target-line continuation))
 (declare-function notmuch-poll "notmuch" ())
 
-(defcustom notmuch-recent-searches-max 10
-  "The number of recent searches to store and display."
+(defcustom notmuch-hello-recent-searches-max 10
+  "The number of recent searches to display."
   :type 'integer
   :group 'notmuch-hello)
 
@@ -154,16 +154,6 @@ International Bureau of Weights and Measures."
 (defvar notmuch-hello-url "http://notmuchmail.org"
   "The `notmuch' web site.")
 
-(defvar notmuch-hello-recent-searches nil)
-
-(defun notmuch-hello-remember-search (search)
-  (setq notmuch-hello-recent-searches
-	(delete search notmuch-hello-recent-searches))
-  (push search notmuch-hello-recent-searches)
-  (if (> (length notmuch-hello-recent-searches)
-	 notmuch-recent-searches-max)
-      (setq notmuch-hello-recent-searches (butlast notmuch-hello-recent-searches))))
-
 (defun notmuch-hello-nice-number (n)
   (let (result)
     (while (> n 0)
@@ -183,9 +173,12 @@ International Bureau of Weights and Measures."
     search))
 
 (defun notmuch-hello-search (search)
-  (let ((search (notmuch-hello-trim search)))
-    (notmuch-hello-remember-search search)
-    (notmuch-search search notmuch-search-oldest-first nil nil #'notmuch-hello-search-continuation)))
+  (unless (null search)
+    (setq search (notmuch-hello-trim search))
+    (let ((history-delete-duplicates t))
+      (add-to-history 'notmuch-search-history search)))
+  (notmuch-search search notmuch-search-oldest-first nil nil
+		  #'notmuch-hello-search-continuation))
 
 (defun notmuch-hello-add-saved-search (widget)
   (interactive)
@@ -464,7 +457,7 @@ Complete list of currently available key bindings:
 
     (let ((found-target-pos nil)
 	  (final-target-pos nil)
-	  (search-bar-pos))
+	  (default-pos))
       (let* ((saved-alist
 	      ;; Filter out empty saved searches if required.
 	      (if notmuch-show-empty-saved-searches
@@ -496,7 +489,7 @@ Complete list of currently available key bindings:
 	    (indent-rigidly start (point) notmuch-hello-indent)))
 
 	(widget-insert "\nSearch: ")
-	(setq search-bar-pos (point-marker))
+	(setq default-pos (point-marker))
 	(widget-create 'editable-field
 		       ;; Leave some space at the start and end of the
 		       ;; search boxes.
@@ -513,18 +506,18 @@ Complete list of currently available key bindings:
 	(put-text-property (1- (point)) (point) 'invisible t)
 	(widget-insert "\n")
 
-	(when notmuch-hello-recent-searches
+	(when notmuch-search-history
 	  (widget-insert "\nRecent searches: ")
 	  (widget-create 'push-button
 			 :notify (lambda (&rest ignore)
-				   (setq notmuch-hello-recent-searches nil)
+				   (setq notmuch-search-history nil)
 				   (notmuch-hello-update))
 			 "clear")
 	  (widget-insert "\n\n")
-	  (let ((start (point))
-		(nth 0))
-	    (mapc (lambda (search)
-		    (let ((widget-symbol (intern (format "notmuch-hello-search-%d" nth))))
+	  (let ((start (point)))
+	    (loop for i from 1 to notmuch-hello-recent-searches-max
+		  for search in notmuch-search-history do
+		    (let ((widget-symbol (intern (format "notmuch-hello-search-%d" i))))
 		      (set widget-symbol
 			   (widget-create 'editable-field
 					  ;; Don't let the search boxes be
@@ -551,9 +544,7 @@ Complete list of currently available key bindings:
 					       (notmuch-hello-add-saved-search widget))
 				     :notmuch-saved-search-widget widget-symbol
 				     "save"))
-		    (widget-insert "\n")
-		    (setq nth (1+ nth)))
-		  notmuch-hello-recent-searches)
+		    (widget-insert "\n"))
 	    (indent-rigidly start (point) notmuch-hello-indent)))
 
 	(when alltags-alist
@@ -582,7 +573,7 @@ Complete list of currently available key bindings:
       (let ((start (point)))
 	(widget-insert "\n\n")
 	(widget-insert "Type a search query and hit RET to view matching threads.\n")
-	(when notmuch-hello-recent-searches
+	(when notmuch-search-history
 	  (widget-insert "Hit RET to re-submit a previous search. Edit it first if you like.\n")
 	  (widget-insert "Save recent searches with the `save' button.\n"))
 	(when notmuch-saved-searches
@@ -600,7 +591,7 @@ Complete list of currently available key bindings:
 	  (widget-forward 1)))
 
       (unless (widget-at)
-	(goto-char search-bar-pos))))
+	(goto-char default-pos))))
 
   (run-hooks 'notmuch-hello-refresh-hook))
 
diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 241fe8c..c906ca7 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -69,6 +69,9 @@
 
 ;;
 
+(defvar notmuch-search-history nil
+  "Variable to store notmuch searches history.")
+
 (defcustom notmuch-saved-searches nil
   "A list of saved searches to display."
   :type '(alist :key-type string :value-type string)
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 3ec0816..e02966f 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -925,21 +925,25 @@ PROMPT is the string to prompt with."
 	       (t (list string)))))))
       ;; this was simpler than convincing completing-read to accept spaces:
       (define-key keymap (kbd "<tab>") 'minibuffer-complete)
-      (read-from-minibuffer prompt nil keymap nil
-			    'notmuch-query-history nil nil))))
+      (let ((history-delete-duplicates t))
+	(read-from-minibuffer prompt nil keymap nil
+			      'notmuch-search-history nil nil)))))
 
 ;;;###autoload
-(defun notmuch-search (query &optional oldest-first target-thread target-line continuation)
-  "Run \"notmuch search\" with the given query string and display results.
+(defun notmuch-search (&optional query oldest-first target-thread target-line continuation)
+  "Run \"notmuch search\" with the given `query' and display results.
 
-The optional parameters are used as follows:
+If `query' is nil, it is read interactively from the minibuffer.
+Other optional parameters are used as follows:
 
   oldest-first: A Boolean controlling the sort order of returned threads
   target-thread: A thread ID (with the thread: prefix) that will be made
                  current if it appears in the search results.
   target-line: The line number to move to if the target thread does not
                appear in the search results."
-  (interactive (list (notmuch-read-query "Notmuch search: ")))
+  (interactive)
+  (if (null query)
+      (setq query (notmuch-read-query "Notmuch search: ")))
   (let ((buffer (get-buffer-create (notmuch-search-buffer-title query))))
     (switch-to-buffer buffer)
     (notmuch-search-mode)
-- 
cgit v1.2.3


From 6bd3d8af5431542f352f084b6366e88b98b019a1 Mon Sep 17 00:00:00 2001
From: David Edmondson <dme@dme.org>
Date: Mon, 30 Jan 2012 10:16:01 +0000
Subject: emacs: Prefer '[No Subject]' to blank subjects.

---
 emacs/notmuch-lib.el   |  9 +++++++++
 emacs/notmuch-print.el |  8 ++++++--
 emacs/notmuch-show.el  |  5 ++++-
 emacs/notmuch.el       | 21 +++++++++------------
 4 files changed, 28 insertions(+), 15 deletions(-)

(limited to 'emacs/notmuch-lib.el')

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index c906ca7..d315f76 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -133,6 +133,15 @@ the user hasn't set this variable with the old or new value."
   (interactive)
   (kill-buffer (current-buffer)))
 
+(defun notmuch-prettify-subject (subject)
+  ;; This function is used by `notmuch-search-process-filter' which
+  ;; requires that we not disrupt its' matching state.
+  (save-match-data
+    (if (and subject
+	     (string-match "^[ \t]*$" subject))
+	"[No Subject]"
+      subject)))
+
 ;;
 
 (defun notmuch-common-do-stash (text)
diff --git a/emacs/notmuch-print.el b/emacs/notmuch-print.el
index 880f96d..6653d97 100644
--- a/emacs/notmuch-print.el
+++ b/emacs/notmuch-print.el
@@ -19,6 +19,8 @@
 ;;
 ;; Authors: David Edmondson <dme@dme.org>
 
+(require 'notmuch-lib)
+
 (declare-function notmuch-show-get-prop "notmuch-show" (prop &optional props))
 
 (defcustom notmuch-print-mechanism 'notmuch-print-lpr
@@ -58,14 +60,16 @@ Optional OUTPUT allows passing a list of flags to muttprint."
 
 (defun notmuch-print-ps-print (msg)
   "Print a message buffer using the ps-print package."
-  (let ((subject (plist-get (notmuch-show-get-prop :headers msg) :Subject)))
+  (let ((subject (notmuch-prettify-subject
+		  (plist-get (notmuch-show-get-prop :headers msg) :Subject))))
     (rename-buffer subject t)
     (ps-print-buffer)))
 
 (defun notmuch-print-ps-print/evince (msg)
   "Preview a message buffer using ps-print and evince."
   (let ((ps-file (make-temp-file "notmuch"))
-	(subject (plist-get (notmuch-show-get-prop :headers msg) :Subject)))
+	(subject (notmuch-prettify-subject
+		  (plist-get (notmuch-show-get-prop :headers msg) :Subject))))
     (rename-buffer subject t)
     (ps-print-buffer ps-file)
     (notmuch-print-run-evince ps-file)))
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 0a945ea..3a1a8c8 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -1018,7 +1018,7 @@ buffer."
       (notmuch-show-next-open-message))
 
     ;; Set the header line to the subject of the first open message.
-    (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject)))
+    (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-pretty-subject)))
 
     (notmuch-show-mark-read)))
 
@@ -1250,6 +1250,9 @@ Some useful entries are:
 (defun notmuch-show-get-depth ()
   (notmuch-show-get-prop :depth))
 
+(defun notmuch-show-get-pretty-subject ()
+  (notmuch-prettify-subject (notmuch-show-get-subject)))
+
 (defun notmuch-show-set-tags (tags)
   "Set the tags of the current message."
   (notmuch-show-set-prop :tags tags)
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 05c2ff7..cd04ffd 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -467,18 +467,14 @@ Complete list of currently available key bindings:
   "Display the currently selected thread."
   (interactive "P")
   (let ((thread-id (notmuch-search-find-thread-id))
-	(subject (notmuch-search-find-subject)))
+	(subject (notmuch-prettify-subject (notmuch-search-find-subject))))
     (if (> (length thread-id) 0)
-	(progn
-	  (if (string-match "^[ \t]*$" subject)
-	      (setq subject "[No Subject]"))
-
-	  (notmuch-show thread-id
-			(current-buffer)
-			notmuch-search-query-string
-			;; Name the buffer based on the subject.
-			(concat "*" (truncate-string-to-width subject 30 nil nil t) "*")
-			crypto-switch))
+	(notmuch-show thread-id
+		      (current-buffer)
+		      notmuch-search-query-string
+		      ;; Name the buffer based on the subject.
+		      (concat "*" (truncate-string-to-width subject 30 nil nil t) "*")
+		      crypto-switch)
       (message "End of search results."))))
 
 (defun notmuch-search-reply-to-thread (&optional prompt-for-sender)
@@ -853,7 +849,8 @@ non-authors is found, assume that all of the authors match."
 		      (if (/= (match-beginning 1) line)
 			  (insert (concat "Error: Unexpected output from notmuch search:\n" (substring string line (match-beginning 1)) "\n")))
 		      (let ((beg (point)))
-			(notmuch-search-show-result date count authors subject tags)
+			(notmuch-search-show-result date count authors
+						    (notmuch-prettify-subject subject) tags)
 			(notmuch-search-color-line beg (point) tag-list)
 			(put-text-property beg (point) 'notmuch-search-thread-id thread-id)
 			(put-text-property beg (point) 'notmuch-search-authors authors)
-- 
cgit v1.2.3


From 950789f3c330d80e083c788777135494dd1bc6d4 Mon Sep 17 00:00:00 2001
From: Adam Wolfe Gordon <awg+notmuch@xvx.ca>
Date: Sun, 18 Mar 2012 10:32:40 -0600
Subject: emacs: Factor out useful functions into notmuch-lib

Move a few functions related to handling multipart/alternative parts
into notmuch-lib.el, so they can be used by future reply code.
---
 emacs/notmuch-lib.el  | 33 +++++++++++++++++++++++++++++++++
 emacs/notmuch-show.el | 24 ++----------------------
 2 files changed, 35 insertions(+), 22 deletions(-)

(limited to 'emacs/notmuch-lib.el')

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index d315f76..7e3f110 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -21,6 +21,8 @@
 
 ;; This is an part of an emacs-based interface to the notmuch mail system.
 
+(eval-when-compile (require 'cl))
+
 (defvar notmuch-command "notmuch"
   "Command to run the notmuch binary.")
 
@@ -173,6 +175,37 @@ the user hasn't set this variable with the old or new value."
   (list 'when (< emacs-major-version 23)
 	form))
 
+(defun notmuch-split-content-type (content-type)
+  "Split content/type into 'content' and 'type'"
+  (split-string content-type "/"))
+
+(defun notmuch-match-content-type (t1 t2)
+  "Return t if t1 and t2 are matching content types, taking wildcards into account"
+  (let ((st1 (notmuch-split-content-type t1))
+	(st2 (notmuch-split-content-type t2)))
+    (if (or (string= (cadr st1) "*")
+	    (string= (cadr st2) "*"))
+	(string= (car st1) (car st2))
+      (string= t1 t2))))
+
+(defvar notmuch-multipart/alternative-discouraged
+  '(
+    ;; Avoid HTML parts.
+    "text/html"
+    ;; multipart/related usually contain a text/html part and some associated graphics.
+    "multipart/related"
+    ))
+
+(defun notmuch-multipart/alternative-choose (types)
+  "Return a list of preferred types from the given list of types"
+  ;; Based on `mm-preferred-alternative-precedence'.
+  (let ((seq types))
+    (dolist (pref (reverse notmuch-multipart/alternative-discouraged))
+      (dolist (elem (copy-sequence seq))
+	(when (string-match pref elem)
+	  (setq seq (nconc (delete elem seq) (list elem))))))
+    seq))
+
 ;; Compatibility functions for versions of emacs before emacs 23.
 ;;
 ;; Both functions here were copied from emacs 23 with the following copyright:
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 4a60631..ed938bf 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -542,30 +542,13 @@ current buffer, if possible."
 	    (mm-display-part handle)
 	    t))))))
 
-(defvar notmuch-show-multipart/alternative-discouraged
-  '(
-    ;; Avoid HTML parts.
-    "text/html"
-    ;; multipart/related usually contain a text/html part and some associated graphics.
-    "multipart/related"
-    ))
-
 (defun notmuch-show-multipart/*-to-list (part)
   (mapcar (lambda (inner-part) (plist-get inner-part :content-type))
 	  (plist-get part :content)))
 
-(defun notmuch-show-multipart/alternative-choose (types)
-  ;; Based on `mm-preferred-alternative-precedence'.
-  (let ((seq types))
-    (dolist (pref (reverse notmuch-show-multipart/alternative-discouraged))
-      (dolist (elem (copy-sequence seq))
-	(when (string-match pref elem)
-	  (setq seq (nconc (delete elem seq) (list elem))))))
-    seq))
-
 (defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth declared-type)
   (notmuch-show-insert-part-header nth declared-type content-type nil)
-  (let ((chosen-type (car (notmuch-show-multipart/alternative-choose (notmuch-show-multipart/*-to-list part))))
+  (let ((chosen-type (car (notmuch-multipart/alternative-choose (notmuch-show-multipart/*-to-list part))))
 	(inner-parts (plist-get part :content))
 	(start (point)))
     ;; This inserts all parts of the chosen type rather than just one,
@@ -808,9 +791,6 @@ current buffer, if possible."
 
 ;; Functions for determining how to handle MIME parts.
 
-(defun notmuch-show-split-content-type (content-type)
-  (split-string content-type "/"))
-
 (defun notmuch-show-handlers-for (content-type)
   "Return a list of content handlers for a part of type CONTENT-TYPE."
   (let (result)
@@ -821,7 +801,7 @@ current buffer, if possible."
 	  (list (intern (concat "notmuch-show-insert-part-*/*"))
 		(intern (concat
 			 "notmuch-show-insert-part-"
-			 (car (notmuch-show-split-content-type content-type))
+			 (car (notmuch-split-content-type content-type))
 			 "/*"))
 		(intern (concat "notmuch-show-insert-part-" content-type))))
     result))
-- 
cgit v1.2.3


From 650123510cfa64caf6b20f5239f43433fa6f2941 Mon Sep 17 00:00:00 2001
From: Adam Wolfe Gordon <awg+notmuch@xvx.ca>
Date: Sun, 18 Mar 2012 10:32:42 -0600
Subject: emacs: Use the new JSON reply format and message-cite-original

Use the new JSON reply format to create replies in emacs. Quote HTML
parts nicely by using mm-display-part to turn them into displayable
text, then quoting them with message-cite-original. This is very
useful for users who regularly receive HTML-only email.

Use message-mode's message-cite-original function to create the
quoted body for reply messages. In order to make this act like the
existing notmuch defaults, you will need to set the following in
your emacs configuration:

message-citation-line-format "On %a, %d %b %Y, %f wrote:"
message-citation-line-function 'message-insert-formatted-citation-line

The tests have been updated to reflect the (ugly) emacs default.
---
 emacs/notmuch-lib.el  |  30 ++++++++++++
 emacs/notmuch-mua.el  | 124 +++++++++++++++++++++++++++++++++-----------------
 emacs/notmuch-show.el |  31 +++----------
 test/emacs            |   8 ++--
 4 files changed, 123 insertions(+), 70 deletions(-)

(limited to 'emacs/notmuch-lib.el')

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 7e3f110..c146748 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -206,6 +206,36 @@ the user hasn't set this variable with the old or new value."
 	  (setq seq (nconc (delete elem seq) (list elem))))))
     seq))
 
+(defun notmuch-parts-filter-by-type (parts type)
+  "Given a list of message parts, return a list containing the ones matching
+the given type."
+  (remove-if-not
+   (lambda (part) (notmuch-match-content-type (plist-get part :content-type) type))
+   parts))
+
+;; Helper for parts which are generally not included in the default
+;; JSON output.
+(defun notmuch-get-bodypart-internal (message-id part-number process-crypto)
+  (let ((args '("show" "--format=raw"))
+	(part-arg (format "--part=%s" part-number)))
+    (setq args (append args (list part-arg)))
+    (if process-crypto
+	(setq args (append args '("--decrypt"))))
+    (setq args (append args (list message-id)))
+    (with-temp-buffer
+      (let ((coding-system-for-read 'no-conversion))
+	(progn
+	  (apply 'call-process (append (list notmuch-command nil (list t nil) nil) args))
+	  (buffer-string))))))
+
+(defun notmuch-get-bodypart-content (msg part nth process-crypto)
+  (or (plist-get part :content)
+      (notmuch-get-bodypart-internal (concat "id:" (plist-get msg :id)) nth process-crypto)))
+
+(defun notmuch-plist-to-alist (plist)
+  (loop for (key value . rest) on plist by #'cddr
+	collect (cons (substring (symbol-name key) 1) value)))
+
 ;; Compatibility functions for versions of emacs before emacs 23.
 ;;
 ;; Both functions here were copied from emacs 23 with the following copyright:
diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el
index 13244eb..6aae3a0 100644
--- a/emacs/notmuch-mua.el
+++ b/emacs/notmuch-mua.el
@@ -19,11 +19,15 @@
 ;;
 ;; Authors: David Edmondson <dme@dme.org>
 
+(require 'json)
 (require 'message)
+(require 'format-spec)
 
 (require 'notmuch-lib)
 (require 'notmuch-address)
 
+(eval-when-compile (require 'cl))
+
 ;;
 
 (defcustom notmuch-mua-send-hook '(notmuch-mua-message-send-hook)
@@ -72,54 +76,92 @@ list."
 	    (push header message-hidden-headers)))
 	notmuch-mua-hidden-headers))
 
+(defun notmuch-mua-get-quotable-parts (parts)
+  (loop for part in parts
+	if (notmuch-match-content-type (plist-get part :content-type) "multipart/alternative")
+	  collect (let* ((subparts (plist-get part :content))
+			(types (mapcar (lambda (part) (plist-get part :content-type)) subparts))
+			(chosen-type (car (notmuch-multipart/alternative-choose types))))
+		   (loop for part in (reverse subparts)
+			 if (notmuch-match-content-type (plist-get part :content-type) chosen-type)
+			 return part))
+	else if (notmuch-match-content-type (plist-get part :content-type) "multipart/*")
+	  append (notmuch-mua-get-quotable-parts (plist-get part :content))
+	else if (notmuch-match-content-type (plist-get part :content-type) "text/*")
+	  collect part))
+
 (defun notmuch-mua-reply (query-string &optional sender reply-all)
-  (let (headers
-	body
-	(args '("reply")))
-    (if notmuch-show-process-crypto
-	(setq args (append args '("--decrypt"))))
+  (let ((args '("reply" "--format=json"))
+	reply
+	original)
+    (when notmuch-show-process-crypto
+      (setq args (append args '("--decrypt"))))
+
     (if reply-all
 	(setq args (append args '("--reply-to=all")))
       (setq args (append args '("--reply-to=sender"))))
     (setq args (append args (list query-string)))
-    ;; This make assumptions about the output of `notmuch reply', but
-    ;; really only that the headers come first followed by a blank
-    ;; line and then the body.
+
+    ;; Get the reply object as JSON, and parse it into an elisp object.
     (with-temp-buffer
       (apply 'call-process (append (list notmuch-command nil (list t t) nil) args))
       (goto-char (point-min))
-      (if (re-search-forward "^$" nil t)
-	  (save-excursion
-	    (save-restriction
-	      (narrow-to-region (point-min) (point))
-	      (goto-char (point-min))
-	      (setq headers (mail-header-extract)))))
-      (forward-line 1)
-      ;; Original message may contain (malicious) MML tags. We must
-      ;; properly quote them in the reply.
-      (mml-quote-region (point) (point-max))
-      (setq body (buffer-substring (point) (point-max))))
-    ;; If sender is non-nil, set the From: header to its value.
-    (when sender
-      (mail-header-set 'from sender headers))
-    (let
-	;; Overlay the composition window on that being used to read
-	;; the original message.
-	((same-window-regexps '("\\*mail .*")))
-      (notmuch-mua-mail (mail-header 'to headers)
-			(mail-header 'subject headers)
-			(message-headers-to-generate headers t '(to subject))))
-    ;; insert the message body - but put it in front of the signature
-    ;; if one is present
-    (goto-char (point-max))
-    (if (re-search-backward message-signature-separator nil t)
+      (let ((json-object-type 'plist)
+	    (json-array-type 'list)
+	    (json-false 'nil))
+	(setq reply (json-read))))
+
+    ;; Extract the original message to simplify the following code.
+    (setq original (plist-get reply :original))
+
+    ;; Extract the headers of both the reply and the original message.
+    (let* ((original-headers (plist-get original :headers))
+	   (reply-headers (plist-get reply :reply-headers)))
+
+      ;; If sender is non-nil, set the From: header to its value.
+      (when sender
+	(plist-put reply-headers :From sender))
+      (let
+	  ;; Overlay the composition window on that being used to read
+	  ;; the original message.
+	  ((same-window-regexps '("\\*mail .*")))
+	(notmuch-mua-mail (plist-get reply-headers :To)
+			  (plist-get reply-headers :Subject)
+			  (notmuch-plist-to-alist reply-headers)))
+      ;; Insert the message body - but put it in front of the signature
+      ;; if one is present
+      (goto-char (point-max))
+      (if (re-search-backward message-signature-separator nil t)
 	  (forward-line -1)
-      (goto-char (point-max)))
-    (insert body)
-    (push-mark))
-  (set-buffer-modified-p nil)
-
-  (message-goto-body))
+	(goto-char (point-max)))
+
+      (let ((from (plist-get original-headers :From))
+	    (date (plist-get original-headers :Date))
+	    (start (point)))
+
+	;; message-cite-original constructs a citation line based on the From and Date
+	;; headers of the original message, which are assumed to be in the buffer.
+	(insert "From: " from "\n")
+	(insert "Date: " date "\n\n")
+
+	;; Get the parts of the original message that should be quoted; this includes
+	;; all the text parts, except the non-preferred ones in a multipart/alternative.
+	(let ((quotable-parts (notmuch-mua-get-quotable-parts (plist-get original :body))))
+	  (mapc (lambda (part)
+		  (insert (notmuch-get-bodypart-content original part
+							(plist-get part :id)
+							notmuch-show-process-crypto)))
+		quotable-parts))
+
+	(set-mark (point))
+	(goto-char start)
+	;; Quote the original message according to the user's configured style.
+	(message-cite-original))))
+
+  (goto-char (point-max))
+  (push-mark)
+  (message-goto-body)
+  (set-buffer-modified-p nil))
 
 (defun notmuch-mua-forward-message ()
   (message-forward)
@@ -145,7 +187,7 @@ OTHER-ARGS are passed through to `message-mail'."
       (when (not (string= "" user-agent))
 	(push (cons "User-Agent" user-agent) other-headers))))
 
-  (unless (mail-header 'from other-headers)
+  (unless (mail-header 'From other-headers)
     (push (cons "From" (concat
 			(notmuch-user-name) " <" (notmuch-user-primary-email) ">")) other-headers))
 
@@ -208,7 +250,7 @@ the From: address first."
   (interactive "P")
   (let ((other-headers
 	 (when (or prompt-for-sender notmuch-always-prompt-for-sender)
-	   (list (cons 'from (notmuch-mua-prompt-for-sender))))))
+	   (list (cons 'From (notmuch-mua-prompt-for-sender))))))
     (notmuch-mua-mail nil nil other-headers)))
 
 (defun notmuch-mua-new-forward-message (&optional prompt-for-sender)
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index ed938bf..0cd7d82 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -488,7 +488,7 @@ message at DEPTH in the current thread."
 	 (setq notmuch-show-process-crypto ,process-crypto)
 	 ;; Always acquires the part via `notmuch part', even if it is
 	 ;; available in the JSON output.
-	 (insert (notmuch-show-get-bodypart-internal ,message-id ,nth))
+	 (insert (notmuch-get-bodypart-internal ,message-id ,nth notmuch-show-process-crypto))
 	 ,@body))))
 
 (defun notmuch-show-save-part (message-id nth &optional filename content-type)
@@ -536,7 +536,7 @@ current buffer, if possible."
 	;; test whether we are able to inline it (which includes both
 	;; capability and suitability tests).
 	(when (mm-inlined-p handle)
-	  (insert (notmuch-show-get-bodypart-content msg part nth))
+	  (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
 	  (when (mm-inlinable-p handle)
 	    (set-buffer display-buffer)
 	    (mm-display-part handle)
@@ -613,8 +613,8 @@ current buffer, if possible."
 	  ;; times (hundreds!), which results in many calls to
 	  ;; `notmuch part'.
 	  (unless content
-	    (setq content (notmuch-show-get-bodypart-internal (concat "id:" message-id)
-							      part-number))
+	    (setq content (notmuch-get-bodypart-internal (concat "id:" message-id)
+							      part-number notmuch-show-process-crypto))
 	    (with-current-buffer w3m-current-buffer
 	      (notmuch-show-w3m-cid-store-internal url
 						   message-id
@@ -734,7 +734,7 @@ current buffer, if possible."
     ;; insert a header to make this clear.
     (if (> nth 1)
 	(notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename)))
-    (insert (notmuch-show-get-bodypart-content msg part nth))
+    (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
     (save-excursion
       (save-restriction
 	(narrow-to-region start (point-max))
@@ -744,7 +744,7 @@ current buffer, if possible."
 (defun notmuch-show-insert-part-text/calendar (msg part content-type nth depth declared-type)
   (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))
   (insert (with-temp-buffer
-	    (insert (notmuch-show-get-bodypart-content msg part nth))
+	    (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
 	    (goto-char (point-min))
 	    (let ((file (make-temp-file "notmuch-ical"))
 		  result)
@@ -806,25 +806,6 @@ current buffer, if possible."
 		(intern (concat "notmuch-show-insert-part-" content-type))))
     result))
 
-;; Helper for parts which are generally not included in the default
-;; JSON output.
-(defun notmuch-show-get-bodypart-internal (message-id part-number)
-  (let ((args '("show" "--format=raw"))
-	(part-arg (format "--part=%s" part-number)))
-    (setq args (append args (list part-arg)))
-    (if notmuch-show-process-crypto
-	(setq args (append args '("--decrypt"))))
-    (setq args (append args (list message-id)))
-    (with-temp-buffer
-      (let ((coding-system-for-read 'no-conversion))
-	(progn
-	  (apply 'call-process (append (list notmuch-command nil (list t nil) nil) args))
-	  (buffer-string))))))
-
-(defun notmuch-show-get-bodypart-content (msg part nth)
-  (or (plist-get part :content)
-      (notmuch-show-get-bodypart-internal (concat "id:" (plist-get msg :id)) nth)))
-
 ;; 
 
 (defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth declared-type)
diff --git a/test/emacs b/test/emacs
index 01afdb6..8a28705 100755
--- a/test/emacs
+++ b/test/emacs
@@ -268,13 +268,13 @@ Subject: Re: Testing message sent via SMTP
 In-Reply-To: <XXX>
 Fcc: ${MAIL_DIR}/sent
 --text follows this line--
-On 01 Jan 2000 12:00:00 -0000, Notmuch Test Suite <test_suite@notmuchmail.org> wrote:
+Notmuch Test Suite <test_suite@notmuchmail.org> writes:
+
 > This is a test that messages are sent via SMTP
 EOF
 test_expect_equal_file OUTPUT EXPECTED
 
 test_begin_subtest "Reply within emacs to a multipart/mixed message"
-test_subtest_known_broken
 test_emacs '(notmuch-show "id:20091118002059.067214ed@hikari")
 		(notmuch-show-reply)
 		(test-output)'
@@ -334,7 +334,6 @@ EOF
 test_expect_equal_file OUTPUT EXPECTED
 
 test_begin_subtest "Reply within emacs to a multipart/alternative message"
-test_subtest_known_broken
 test_emacs '(notmuch-show "id:cf0c4d610911171136h1713aa59w9cf9aa31f052ad0a@mail.gmail.com")
 		(notmuch-show-reply)
 		(test-output)'
@@ -385,7 +384,8 @@ Subject: Re: Quote MML tags in reply
 In-Reply-To: <test-emacs-mml-quoting@message.id>
 Fcc: ${MAIL_DIR}/sent
 --text follows this line--
-On Fri, 05 Jan 2001 15:43:57 +0000, Notmuch Test Suite <test_suite@notmuchmail.org> wrote:
+Notmuch Test Suite <test_suite@notmuchmail.org> writes:
+
 > <#!part disposition=inline>
 EOF
 test_expect_equal_file OUTPUT EXPECTED
-- 
cgit v1.2.3


From f57ef643026540d6eb20179ccc92e54445a9d21a Mon Sep 17 00:00:00 2001
From: Mark Walters <markwalters1009@gmail.com>
Date: Sun, 25 Mar 2012 00:43:28 +0000
Subject: emacs: content-type comparison should be case insensitive.

The function notmuch-match-content-type was comparing content types
case sensitively. Fix it so it tests case insensitively.

This fixes a bug where emacs would not include any body when replying
to a message with content-type TEXT/PLAIN.
---
 emacs/notmuch-lib.el | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

(limited to 'emacs/notmuch-lib.el')

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index c146748..a754de7 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -185,8 +185,9 @@ the user hasn't set this variable with the old or new value."
 	(st2 (notmuch-split-content-type t2)))
     (if (or (string= (cadr st1) "*")
 	    (string= (cadr st2) "*"))
-	(string= (car st1) (car st2))
-      (string= t1 t2))))
+	;; Comparison of content types should be case insensitive.
+	(string= (downcase (car st1)) (downcase (car st2)))
+      (string= (downcase t1) (downcase t2)))))
 
 (defvar notmuch-multipart/alternative-discouraged
   '(
-- 
cgit v1.2.3


From ee1180018ee3c772d7ac769222ff9c6940f3c838 Mon Sep 17 00:00:00 2001
From: Austin Clements <amdragon@MIT.EDU>
Date: Mon, 26 Mar 2012 21:37:16 -0400
Subject: emacs: Escape all message ID queries

This adds a lib function to turn a message ID into a properly escaped
message ID query and uses this function wherever we previously
hand-constructed ID queries.  Wherever this new function is used,
documentation has been clarified to refer to "id: queries" instead of
"message IDs".

This fixes the broken test introduced by the previous patch.
---
 emacs/notmuch-lib.el     |  6 +++++-
 emacs/notmuch-message.el |  2 +-
 emacs/notmuch-show.el    | 14 +++++++-------
 test/emacs               |  1 -
 4 files changed, 13 insertions(+), 10 deletions(-)

(limited to 'emacs/notmuch-lib.el')

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index a754de7..2492b80 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -144,6 +144,10 @@ the user hasn't set this variable with the old or new value."
 	"[No Subject]"
       subject)))
 
+(defun notmuch-id-to-query (id)
+  "Return a query that matches the message with id ID."
+  (concat "id:\"" (replace-regexp-in-string "\"" "\"\"" id t t) "\""))
+
 ;;
 
 (defun notmuch-common-do-stash (text)
@@ -231,7 +235,7 @@ the given type."
 
 (defun notmuch-get-bodypart-content (msg part nth process-crypto)
   (or (plist-get part :content)
-      (notmuch-get-bodypart-internal (concat "id:" (plist-get msg :id)) nth process-crypto)))
+      (notmuch-get-bodypart-internal (notmuch-id-to-query (plist-get msg :id)) nth process-crypto)))
 
 (defun notmuch-plist-to-alist (plist)
   (loop for (key value . rest) on plist by #'cddr
diff --git a/emacs/notmuch-message.el b/emacs/notmuch-message.el
index 264a5b9..3010281 100644
--- a/emacs/notmuch-message.el
+++ b/emacs/notmuch-message.el
@@ -44,7 +44,7 @@ the \"inbox\" and \"todo\", you would set
 				(concat "+" str)
 			      str))
 			  notmuch-message-replied-tags)))
-	(apply 'notmuch-tag (concat "id:" (car (car rep))) tags)))))
+	(apply 'notmuch-tag (notmuch-id-to-query (car (car rep))) tags)))))
 
 (add-hook 'message-send-hook 'notmuch-message-mark-replied)
 
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 0cd7d82..6d3fe62 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -613,7 +613,7 @@ current buffer, if possible."
 	  ;; times (hundreds!), which results in many calls to
 	  ;; `notmuch part'.
 	  (unless content
-	    (setq content (notmuch-get-bodypart-internal (concat "id:" message-id)
+	    (setq content (notmuch-get-bodypart-internal (notmuch-id-to-query message-id)
 							      part-number notmuch-show-process-crypto))
 	    (with-current-buffer w3m-current-buffer
 	      (notmuch-show-w3m-cid-store-internal url
@@ -1325,16 +1325,16 @@ Some useful entries are:
     (plist-get props prop)))
 
 (defun notmuch-show-get-message-id (&optional bare)
-  "Return the Message-Id of the current message.
+  "Return an id: query for the Message-Id of the current message.
 
 If optional argument BARE is non-nil, return
-the Message-Id without prefix and quotes."
+the Message-Id without id: prefix and escaping."
   (if bare
       (notmuch-show-get-prop :id)
-    (concat "id:\"" (notmuch-show-get-prop :id) "\"")))
+    (notmuch-id-to-query (notmuch-show-get-prop :id))))
 
 (defun notmuch-show-get-messages-ids ()
-  "Return all message ids of messages in the current thread."
+  "Return all id: queries of messages in the current thread."
   (let ((message-ids))
     (notmuch-show-mapc
      (lambda () (push (notmuch-show-get-message-id) message-ids)))
@@ -1401,7 +1401,7 @@ current thread."
 ;; thread.
 
 (defun notmuch-show-get-message-ids-for-open-messages ()
-  "Return a list of all message IDs for open messages in the current thread."
+  "Return a list of all id: queries for open messages in the current thread."
   (save-excursion
     (let (message-ids done)
       (goto-char (point-min))
@@ -1805,7 +1805,7 @@ thread from search."
   (notmuch-common-do-stash (notmuch-show-get-from)))
 
 (defun notmuch-show-stash-message-id ()
-  "Copy message ID of current message to kill-ring."
+  "Copy id: query matching the current message to kill-ring."
   (interactive)
   (notmuch-common-do-stash (notmuch-show-get-message-id)))
 
diff --git a/test/emacs b/test/emacs
index 62eaedb..8b92d0a 100755
--- a/test/emacs
+++ b/test/emacs
@@ -140,7 +140,6 @@ output=$(notmuch search 'id:"123..456@example"' | notmuch_search_sanitize)
 test_expect_equal "$output" "thread:XXX   2001-01-05 [1/1] Notmuch Test Suite; Message with .. in Message-Id (inbox search-add show-add)"
 
 test_begin_subtest "Message with quote in Message-Id:"
-test_subtest_known_broken
 add_message '[id]="\"quote\"@example"' '[subject]="Message with quote in Message-Id"'
 test_emacs '(notmuch-search "subject:\"Message with quote\"")
 	    (notmuch-test-wait)
-- 
cgit v1.2.3


From 839a80513a2dc961cab9348bd1442f30611b0fe4 Mon Sep 17 00:00:00 2001
From: Austin Clements <amdragon@MIT.EDU>
Date: Mon, 26 Mar 2012 21:40:26 -0400
Subject: emacs: Fix mis-named argument to notmuch-get-bodypart-internal

Previously, this function took an argument called "message-id", even
though it was a general query, rather than a message ID.  This changes
it to "query".
---
 emacs/notmuch-lib.el | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'emacs/notmuch-lib.el')

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 2492b80..c159dda 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -220,13 +220,13 @@ the given type."
 
 ;; Helper for parts which are generally not included in the default
 ;; JSON output.
-(defun notmuch-get-bodypart-internal (message-id part-number process-crypto)
+(defun notmuch-get-bodypart-internal (query part-number process-crypto)
   (let ((args '("show" "--format=raw"))
 	(part-arg (format "--part=%s" part-number)))
     (setq args (append args (list part-arg)))
     (if process-crypto
 	(setq args (append args '("--decrypt"))))
-    (setq args (append args (list message-id)))
+    (setq args (append args (list query)))
     (with-temp-buffer
       (let ((coding-system-for-read 'no-conversion))
 	(progn
-- 
cgit v1.2.3


From 3737ca6e268e6f45353bfbcc4ac4b1d548c5908d Mon Sep 17 00:00:00 2001
From: Adam Wolfe Gordon <awg+notmuch@xvx.ca>
Date: Sun, 1 Apr 2012 09:24:21 -0600
Subject: emacs: Fix two bugs in reply

Bug 1: Replying from alternate addresses
----------------------------------------

The reply code was inconsistent in its use of symbols and strings for
header names being passed to message.el functions. This caused the
From header to be lookup up incorrectly, causing an additional From
header to be added with the user's primary address instead of the
correct alternate address.

This is fixed by using symbols everywhere, i.e. never using strings
for header names when interacting with message.el.

This change also removes our use of `mail-header`, since we don't use
it anywhere else, and using assq makes it clear how the header lists
are expected to work.

Bug 2: Duplicate headers in emacs 23.2
--------------------------------------

The message.el code in emacs 23.2 assumes that header names will
always be passed as symbols, so our use of strings caused
problems. The symptom was that on 23.2 (and presumably on earlier
versions) the reply message would end up with two of some headers.

Converting everything to symbols also fixes this issue.
---
 emacs/notmuch-lib.el |  7 +++++--
 emacs/notmuch-mua.el | 10 +++++-----
 test/emacs           |  1 -
 3 files changed, 10 insertions(+), 8 deletions(-)

(limited to 'emacs/notmuch-lib.el')

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index c159dda..6907a5f 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -237,9 +237,12 @@ the given type."
   (or (plist-get part :content)
       (notmuch-get-bodypart-internal (notmuch-id-to-query (plist-get msg :id)) nth process-crypto)))
 
-(defun notmuch-plist-to-alist (plist)
+;; Converts a plist of headers to an alist of headers. The input plist should
+;; have symbols of the form :Header as keys, and the resulting alist will have
+;; symbols of the form 'Header as keys.
+(defun notmuch-headers-plist-to-alist (plist)
   (loop for (key value . rest) on plist by #'cddr
-	collect (cons (substring (symbol-name key) 1) value)))
+	collect (cons (intern (substring (symbol-name key) 1)) value)))
 
 ;; Compatibility functions for versions of emacs before emacs 23.
 ;;
diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el
index 6aae3a0..cfa3d61 100644
--- a/emacs/notmuch-mua.el
+++ b/emacs/notmuch-mua.el
@@ -127,7 +127,7 @@ list."
 	  ((same-window-regexps '("\\*mail .*")))
 	(notmuch-mua-mail (plist-get reply-headers :To)
 			  (plist-get reply-headers :Subject)
-			  (notmuch-plist-to-alist reply-headers)))
+			  (notmuch-headers-plist-to-alist reply-headers)))
       ;; Insert the message body - but put it in front of the signature
       ;; if one is present
       (goto-char (point-max))
@@ -185,11 +185,11 @@ OTHER-ARGS are passed through to `message-mail'."
   (when notmuch-mua-user-agent-function
     (let ((user-agent (funcall notmuch-mua-user-agent-function)))
       (when (not (string= "" user-agent))
-	(push (cons "User-Agent" user-agent) other-headers))))
+	(push (cons 'User-Agent user-agent) other-headers))))
 
-  (unless (mail-header 'From other-headers)
-    (push (cons "From" (concat
-			(notmuch-user-name) " <" (notmuch-user-primary-email) ">")) other-headers))
+  (unless (assq 'From other-headers)
+    (push (cons 'From (concat
+		       (notmuch-user-name) " <" (notmuch-user-primary-email) ">")) other-headers))
 
   (apply #'message-mail to subject other-headers other-args)
   (message-sort-headers)
diff --git a/test/emacs b/test/emacs
index 576bc1f..30654bb 100755
--- a/test/emacs
+++ b/test/emacs
@@ -286,7 +286,6 @@ EOF
 test_expect_equal_file OUTPUT EXPECTED
 
 test_begin_subtest "Reply from alternate address within emacs"
-test_subtest_known_broken
 add_message '[from]="Sender <sender@example.com>"' \
 	     [to]=test_suite_other@notmuchmail.org
 
-- 
cgit v1.2.3


From f6c170fabca8f39e74705e3813504137811bf162 Mon Sep 17 00:00:00 2001
From: Adam Wolfe Gordon <awg+notmuch@xvx.ca>
Date: Sat, 5 May 2012 13:30:37 -0600
Subject: emacs: Correctly quote non-text/plain parts in reply

Quote non-text parts nicely by displaying them with mm-display-part
before calling message-cite-original to quote them. HTML-only emails
can now be quoted correctly. We re-use some code from notmuch-show
(notmuch-show-mm-display-part-inline), which has been moved to
notmuch-lib.el.

Mark the test for this feature as not broken.
---
 emacs/notmuch-lib.el  | 19 +++++++++++++++++++
 emacs/notmuch-mua.el  | 15 ++++++++++-----
 emacs/notmuch-show.el | 19 +------------------
 test/emacs            |  1 -
 4 files changed, 30 insertions(+), 24 deletions(-)

(limited to 'emacs/notmuch-lib.el')

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 6907a5f..7fa441a 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -21,6 +21,8 @@
 
 ;; This is an part of an emacs-based interface to the notmuch mail system.
 
+(require 'mm-view)
+(require 'mm-decode)
 (eval-when-compile (require 'cl))
 
 (defvar notmuch-command "notmuch"
@@ -237,6 +239,23 @@ the given type."
   (or (plist-get part :content)
       (notmuch-get-bodypart-internal (notmuch-id-to-query (plist-get msg :id)) nth process-crypto)))
 
+(defun notmuch-mm-display-part-inline (msg part nth content-type process-crypto)
+  "Use the mm-decode/mm-view functions to display a part in the
+current buffer, if possible."
+  (let ((display-buffer (current-buffer)))
+    (with-temp-buffer
+      (let* ((charset (plist-get part :content-charset))
+	     (handle (mm-make-handle (current-buffer) `(,content-type (charset . ,charset)))))
+	;; If the user wants the part inlined, insert the content and
+	;; test whether we are able to inline it (which includes both
+	;; capability and suitability tests).
+	(when (mm-inlined-p handle)
+	  (insert (notmuch-get-bodypart-content msg part nth process-crypto))
+	  (when (mm-inlinable-p handle)
+	    (set-buffer display-buffer)
+	    (mm-display-part handle)
+	    t))))))
+
 ;; Converts a plist of headers to an alist of headers. The input plist should
 ;; have symbols of the form :Header as keys, and the resulting alist will have
 ;; symbols of the form 'Header as keys.
diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el
index 87bd88d..fc7ae07 100644
--- a/emacs/notmuch-mua.el
+++ b/emacs/notmuch-mua.el
@@ -21,6 +21,7 @@
 
 (require 'json)
 (require 'message)
+(require 'mm-view)
 (require 'format-spec)
 
 (require 'notmuch-lib)
@@ -90,6 +91,14 @@ list."
 	else if (notmuch-match-content-type (plist-get part :content-type) "text/*")
 	  collect part))
 
+(defun notmuch-mua-insert-quotable-part (message part)
+  (save-restriction
+    (narrow-to-region (point) (point))
+    (notmuch-mm-display-part-inline message part (plist-get part :id)
+				    (plist-get part :content-type)
+				    notmuch-show-process-crypto)
+    (goto-char (point-max))))
+
 ;; There is a bug in emacs 23's message.el that results in a newline
 ;; not being inserted after the References header, so the next header
 ;; is concatenated to the end of it. This function fixes the problem,
@@ -169,11 +178,7 @@ list."
 	;; Get the parts of the original message that should be quoted; this includes
 	;; all the text parts, except the non-preferred ones in a multipart/alternative.
 	(let ((quotable-parts (notmuch-mua-get-quotable-parts (plist-get original :body))))
-	  (mapc (lambda (part)
-		  (insert (notmuch-get-bodypart-content original part
-							(plist-get part :id)
-							notmuch-show-process-crypto)))
-		quotable-parts))
+	  (mapc (apply-partially 'notmuch-mua-insert-quotable-part original) quotable-parts))
 
 	(set-mark (point))
 	(goto-char start)
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 37f0ebb..d318430 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -524,23 +524,6 @@ message at DEPTH in the current thread."
     (let ((handle (mm-make-handle (current-buffer) (list content-type))))
       (mm-interactively-view-part handle))))
 
-(defun notmuch-show-mm-display-part-inline (msg part nth content-type)
-  "Use the mm-decode/mm-view functions to display a part in the
-current buffer, if possible."
-  (let ((display-buffer (current-buffer)))
-    (with-temp-buffer
-      (let* ((charset (plist-get part :content-charset))
-	     (handle (mm-make-handle (current-buffer) `(,content-type (charset . ,charset)))))
-	;; If the user wants the part inlined, insert the content and
-	;; test whether we are able to inline it (which includes both
-	;; capability and suitability tests).
-	(when (mm-inlined-p handle)
-	  (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
-	  (when (mm-inlinable-p handle)
-	    (set-buffer display-buffer)
-	    (mm-display-part handle)
-	    t))))))
-
 (defun notmuch-show-multipart/*-to-list (part)
   (mapcar (lambda (inner-part) (plist-get inner-part :content-type))
 	  (plist-get part :content)))
@@ -785,7 +768,7 @@ current buffer, if possible."
 (defun notmuch-show-insert-part-*/* (msg part content-type nth depth declared-type)
   ;; This handler _must_ succeed - it is the handler of last resort.
   (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename))
-  (notmuch-show-mm-display-part-inline msg part nth content-type)
+  (notmuch-mm-display-part-inline msg part nth content-type notmuch-show-process-crypto)
   t)
 
 ;; Functions for determining how to handle MIME parts.
diff --git a/test/emacs b/test/emacs
index 5f238d9..a615b39 100755
--- a/test/emacs
+++ b/test/emacs
@@ -445,7 +445,6 @@ EOF
 test_expect_equal_file OUTPUT EXPECTED
 
 test_begin_subtest "Reply within emacs to an html-only message"
-test_subtest_known_broken
 add_message '[content-type]="text/html"' \
 	    '[body]="Hi,<br />This is an <b>HTML</b> test message.<br /><br />OK?"'
 test_emacs "(let ((message-hidden-headers '()))
-- 
cgit v1.2.3


From 70ca3444c75beaa693fcac411dd6a2819bd4341e Mon Sep 17 00:00:00 2001
From: Tomi Ollila <tomi.ollila@iki.fi>
Date: Sun, 20 May 2012 19:58:14 +0300
Subject: emacs: use 'gnus-decoded in notmuch-mm-display-part-inline ()

When mail message is read from emacs, the message structure
obtained may contain parts which have content included
(`text/plain` for example) and other parts where content is not
included (`text/html` for example).

In case content is included, the string is already available in
emacs' internal format and therefore mm-... functions should not
attempt to do further decoding for the data in temp buffer
provided for it.

Currently when reply buffer is created,
notmuch-mm-display-part-inline () is used to provided quoted reply
content. This change makes the mm-... functions called by it use
'gnus-decoded as charset whenever the content is already available.

File .../emacs-23.3/lisp/gnus/mm-uu.el mentions:
"`gnus-decoded' is a fake charset, which means no further decoding."
---
 emacs/notmuch-lib.el | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

(limited to 'emacs/notmuch-lib.el')

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 7fa441a..e99b48d 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -244,7 +244,12 @@ the given type."
 current buffer, if possible."
   (let ((display-buffer (current-buffer)))
     (with-temp-buffer
-      (let* ((charset (plist-get part :content-charset))
+      ;; In case there is :content, the content string is already converted
+      ;; into emacs internal format. `gnus-decoded' is a fake charset,
+      ;; which means no further decoding (to be done by mm- functions).
+      (let* ((charset (if (plist-member part :content)
+			  'gnus-decoded
+			(plist-get part :content-charset)))
 	     (handle (mm-make-handle (current-buffer) `(,content-type (charset . ,charset)))))
 	;; If the user wants the part inlined, insert the content and
 	;; test whether we are able to inline it (which includes both
-- 
cgit v1.2.3


From 44224b6259c82a20f93f19bfab83b817c8009efe Mon Sep 17 00:00:00 2001
From: Austin Clements <amdragon@MIT.EDU>
Date: Thu, 29 Mar 2012 00:33:42 -0400
Subject: emacs: Suppress warnings about using cl at runtime

It was decided in the thread starting at [0] that it is okay for
notmuch to use 'cl runtime functions.  However, by default, these
produce byte compiler warnings.  This suppresses those using
file-local variables.

[0] id:"m262g864dz.fsf@wal122.wireless-pennnet.upenn.edu"
---
 emacs/notmuch-lib.el | 3 +++
 1 file changed, 3 insertions(+)

(limited to 'emacs/notmuch-lib.el')

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index e99b48d..c829df3 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -298,3 +298,6 @@ was called."
 
 (provide 'notmuch-lib)
 
+;; Local Variables:
+;; byte-compile-warnings: (not cl-functions)
+;; End:
-- 
cgit v1.2.3


From 889dda3731dcdf779cef347576c5d59d1923d26b Mon Sep 17 00:00:00 2001
From: Austin Clements <amdragon@MIT.EDU>
Date: Mon, 9 Jul 2012 17:42:40 -0400
Subject: emacs: Implement an incremental JSON parser

This parser is designed to read streaming JSON whose structure is
known to the caller.  Like a typical JSON parsing interface, it
provides a function to read a complete JSON value from the input.
However, it extends this with an additional function that
requires the next value in the input to be a compound value and
descends into it, allowing its elements to be read one at a time
or further descended into.  Both functions can return 'retry to
indicate that not enough input is available.

The parser supports efficient partial parsing, so there's no need to
frame the input for correctness or performance.

The bulk of the parsing is still done by Emacs' json.el, so any
improvements or optimizations to that will benefit the incremental
parser as well.

Currently only descending into JSON lists is supported because that's
all we need, but support for descending into JSON objects can be added
in the future.
---
 emacs/notmuch-lib.el | 197 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 197 insertions(+)

(limited to 'emacs/notmuch-lib.el')

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index c829df3..aa25513 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -23,6 +23,7 @@
 
 (require 'mm-view)
 (require 'mm-decode)
+(require 'json)
 (eval-when-compile (require 'cl))
 
 (defvar notmuch-command "notmuch"
@@ -296,6 +297,202 @@ was called."
 (defvar notmuch-show-process-crypto nil)
 (make-variable-buffer-local 'notmuch-show-process-crypto)
 
+;; Incremental JSON parsing
+
+(defun notmuch-json-create-parser (buffer)
+  "Return a streaming JSON parser that consumes input from BUFFER.
+
+This parser is designed to read streaming JSON whose structure is
+known to the caller.  Like a typical JSON parsing interface, it
+provides a function to read a complete JSON value from the input.
+However, it extends this with an additional function that
+requires the next value in the input to be a compound value and
+descends into it, allowing its elements to be read one at a time
+or further descended into.  Both functions can return 'retry to
+indicate that not enough input is available.
+
+The parser always consumes input from BUFFER's point.  Hence, the
+caller is allowed to delete and data before point and may
+resynchronize after an error by moving point."
+
+  (list buffer
+	;; Terminator stack: a stack of characters that indicate the
+	;; end of the compound values enclosing point
+	'()
+	;; Next: One of
+	;; * 'expect-value if the next token must be a value, but a
+	;;   value has not yet been reached
+	;; * 'value if point is at the beginning of a value
+	;; * 'expect-comma if the next token must be a comma
+	'expect-value
+	;; Allow terminator: non-nil if the next token may be a
+	;; terminator
+	nil
+	;; Partial parse position: If state is 'value, a marker for
+	;; the position of the partial parser or nil if no partial
+	;; parsing has happened yet
+	nil
+	;; Partial parse state: If state is 'value, the current
+	;; `parse-partial-sexp' state
+	nil))
+
+(defmacro notmuch-json-buffer (jp) `(first ,jp))
+(defmacro notmuch-json-term-stack (jp) `(second ,jp))
+(defmacro notmuch-json-next (jp) `(third ,jp))
+(defmacro notmuch-json-allow-term (jp) `(fourth ,jp))
+(defmacro notmuch-json-partial-pos (jp) `(fifth ,jp))
+(defmacro notmuch-json-partial-state (jp) `(sixth ,jp))
+
+(defvar notmuch-json-syntax-table
+  (let ((table (make-syntax-table)))
+    ;; The standard syntax table is what we need except that "." needs
+    ;; to have word syntax instead of punctuation syntax.
+    (modify-syntax-entry ?. "w" table)
+    table)
+  "Syntax table used for incremental JSON parsing.")
+
+(defun notmuch-json-scan-to-value (jp)
+  ;; Helper function that consumes separators, terminators, and
+  ;; whitespace from point.  Returns nil if it successfully reached
+  ;; the beginning of a value, 'end if it consumed a terminator, or
+  ;; 'retry if not enough input was available to reach a value.  Upon
+  ;; nil return, (notmuch-json-next jp) is always 'value.
+
+  (if (eq (notmuch-json-next jp) 'value)
+      ;; We're already at a value
+      nil
+    ;; Drive the state toward 'expect-value
+    (skip-chars-forward " \t\r\n")
+    (or (when (eobp) 'retry)
+	;; Test for the terminator for the current compound
+	(when (and (notmuch-json-allow-term jp)
+		   (eq (char-after) (car (notmuch-json-term-stack jp))))
+	  ;; Consume it and expect a comma or terminator next
+	  (forward-char)
+	  (setf (notmuch-json-term-stack jp) (cdr (notmuch-json-term-stack jp))
+		(notmuch-json-next jp) 'expect-comma
+		(notmuch-json-allow-term jp) t)
+	  'end)
+	;; Test for a separator
+	(when (eq (notmuch-json-next jp) 'expect-comma)
+	  (when (/= (char-after) ?,)
+	    (signal 'json-readtable-error (list "expected ','")))
+	  ;; Consume it, switch to 'expect-value, and disallow a
+	  ;; terminator
+	  (forward-char)
+	  (skip-chars-forward " \t\r\n")
+	  (setf (notmuch-json-next jp) 'expect-value
+		(notmuch-json-allow-term jp) nil)
+	  ;; We moved point, so test for eobp again and fall through
+	  ;; to the next test if there's more input
+	  (when (eobp) 'retry))
+	;; Next must be 'expect-value and we know this isn't
+	;; whitespace, EOB, or a terminator, so point must be on a
+	;; value
+	(progn
+	  (assert (eq (notmuch-json-next jp) 'expect-value))
+	  (setf (notmuch-json-next jp) 'value)
+	  nil))))
+
+(defun notmuch-json-begin-compound (jp)
+  "Parse the beginning of a compound value and traverse inside it.
+
+Returns 'retry if there is insufficient input to parse the
+beginning of the compound.  If this is able to parse the
+beginning of a compound, it moves point past the token that opens
+the compound and returns t.  Later calls to `notmuch-json-read'
+will return the compound's elements.
+
+Entering JSON objects is currently unimplemented."
+
+  (with-current-buffer (notmuch-json-buffer jp)
+    ;; Disallow terminators
+    (setf (notmuch-json-allow-term jp) nil)
+    (or (notmuch-json-scan-to-value jp)
+	(if (/= (char-after) ?\[)
+	    (signal 'json-readtable-error (list "expected '['"))
+	  (forward-char)
+	  (push ?\] (notmuch-json-term-stack jp))
+	  ;; Expect a value or terminator next
+	  (setf (notmuch-json-next jp) 'expect-value
+		(notmuch-json-allow-term jp) t)
+	  t))))
+
+(defun notmuch-json-read (jp)
+  "Parse the value at point in JP's buffer.
+
+Returns 'retry if there is insufficient input to parse a complete
+JSON value (though it may still move point over separators or
+whitespace).  If the parser is currently inside a compound value
+and the next token ends the list or object, this moves point just
+past the terminator and returns 'end.  Otherwise, this moves
+point to just past the end of the value and returns the value."
+
+  (with-current-buffer (notmuch-json-buffer jp)
+    (or
+     ;; Get to a value state
+     (notmuch-json-scan-to-value jp)
+
+     ;; Can we parse a complete value?
+     (let ((complete
+	    (if (looking-at "[-+0-9tfn]")
+		;; This is a number or a keyword, so the partial
+		;; parser isn't going to help us because a truncated
+		;; number or keyword looks like a complete symbol to
+		;; it.  Look for something that clearly ends it.
+		(save-excursion
+		  (skip-chars-forward "^]},: \t\r\n")
+		  (not (eobp)))
+
+	      ;; We're looking at a string, object, or array, which we
+	      ;; can partial parse.  If we just reached the value, set
+	      ;; up the partial parser.
+	      (when (null (notmuch-json-partial-state jp))
+		(setf (notmuch-json-partial-pos jp) (point-marker)))
+
+	      ;; Extend the partial parse until we either reach EOB or
+	      ;; get the whole value
+	      (save-excursion
+		(let ((pstate
+		       (with-syntax-table notmuch-json-syntax-table
+			 (parse-partial-sexp
+			  (notmuch-json-partial-pos jp) (point-max) 0 nil
+			  (notmuch-json-partial-state jp)))))
+		  ;; A complete value is available if we've reached
+		  ;; depth 0 or less and encountered a complete
+		  ;; subexpression.
+		  (if (and (<= (first pstate) 0) (third pstate))
+		      t
+		    ;; Not complete.  Update the partial parser state
+		    (setf (notmuch-json-partial-pos jp) (point-marker)
+			  (notmuch-json-partial-state jp) pstate)
+		    nil))))))
+
+       (if (not complete)
+	   'retry
+	 ;; We have a value.  Reset the partial parse state and expect
+	 ;; a comma or terminator after the value.
+	 (setf (notmuch-json-next jp) 'expect-comma
+	       (notmuch-json-allow-term jp) t
+	       (notmuch-json-partial-pos jp) nil
+	       (notmuch-json-partial-state jp) nil)
+	 ;; Parse the value
+	 (let ((json-object-type 'plist)
+	       (json-array-type 'list)
+	       (json-false nil))
+	   (json-read)))))))
+
+(defun notmuch-json-eof (jp)
+  "Signal a json-error if there is more data in JP's buffer.
+
+Moves point to the beginning of any trailing data or to the end
+of the buffer if there is only trailing whitespace."
+
+  (with-current-buffer (notmuch-json-buffer jp)
+    (skip-chars-forward " \t\r\n")
+    (unless (eobp)
+      (signal 'json-error (list "Trailing garbage following JSON data")))))
+
 (provide 'notmuch-lib)
 
 ;; Local Variables:
-- 
cgit v1.2.3


From 60ebc84945731e37d6cbec19ce51c08c408b49e8 Mon Sep 17 00:00:00 2001
From: Austin Clements <amdragon@MIT.EDU>
Date: Sat, 21 Jul 2012 13:37:06 -0400
Subject: emacs: Use text properties instead of overlays for tag coloring

Previously, tag-based search result highlighting was done by creating
an overlay over each search result.  However, overlays have annoying
front- and rear-advancement semantics that make it difficult to
manipulate text at their boundaries, which the next patch will do.
They also have performance problems (creating an overlay is linear in
the number of overlays between point and the new overlay, making
highlighting a search buffer quadratic in the number of results).

Text properties have neither problem.  However, text properties make
it more difficult to apply multiple faces since, unlike with overlays,
a given character can only have a single 'face text property.  Hence,
we introduce a utility function that combines faces into any existing
'face text properties.

Using this utility function, it's straightforward to apply all of the
appropriate tag faces in notmuch-search-color-line.
---
 emacs/notmuch-lib.el | 15 +++++++++++++++
 emacs/notmuch.el     | 21 +++++++--------------
 2 files changed, 22 insertions(+), 14 deletions(-)

(limited to 'emacs/notmuch-lib.el')

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index aa25513..30db58f 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -269,6 +269,21 @@ current buffer, if possible."
   (loop for (key value . rest) on plist by #'cddr
 	collect (cons (intern (substring (symbol-name key) 1)) value)))
 
+(defun notmuch-combine-face-text-property (start end face)
+  "Combine FACE into the 'face text property between START and END.
+
+This function combines FACE with any existing faces between START
+and END.  Attributes specified by FACE take precedence over
+existing attributes.  FACE must be a face name (a symbol or
+string), a property list of face attributes, or a list of these."
+
+  (let ((pos start))
+    (while (< pos end)
+      (let ((cur (get-text-property pos 'face))
+	    (next (next-single-property-change pos 'face nil end)))
+	(put-text-property pos next 'face (cons face cur))
+	(setq pos next)))))
+
 ;; Compatibility functions for versions of emacs before emacs 23.
 ;;
 ;; Both functions here were copied from emacs 23 with the following copyright:
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index ef18927..82c148d 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -633,20 +633,13 @@ foreground and blue background."
 
 (defun notmuch-search-color-line (start end line-tag-list)
   "Colorize lines in `notmuch-show' based on tags."
-  ;; Create the overlay only if the message has tags which match one
-  ;; of those specified in `notmuch-search-line-faces'.
-  (let (overlay)
-    (mapc (lambda (elem)
-	    (let ((tag (car elem))
-		  (attributes (cdr elem)))
-	      (when (member tag line-tag-list)
-		(when (not overlay)
-		  (setq overlay (make-overlay start end)))
-		;; Merge the specified properties with any already
-		;; applied from an earlier match.
-		(overlay-put overlay 'face
-			     (append (overlay-get overlay 'face) attributes)))))
-	  notmuch-search-line-faces)))
+  (mapc (lambda (elem)
+	  (let ((tag (car elem))
+		(attributes (cdr elem)))
+	    (when (member tag line-tag-list)
+	      (notmuch-combine-face-text-property start end attributes))))
+	;; Reverse the list so earlier entries take precedence
+	(reverse notmuch-search-line-faces)))
 
 (defun notmuch-search-author-propertize (authors)
   "Split `authors' into matching and non-matching authors and
-- 
cgit v1.2.3