? imap-search.patch
Index: contrib/nnir.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/contrib/nnir.el,v
retrieving revision 7.22
diff -u -r7.22 nnir.el
--- contrib/nnir.el	4 Oct 2007 18:51:27 -0000	7.22
+++ contrib/nnir.el	10 Dec 2007 11:18:15 -0000
@@ -886,6 +886,9 @@
 ;; handle errors
 
 (defun nnir-run-imap (query srv &optional group-option)
+  "Run a search against an IMAP back-end server.
+This uses a custom query language parser; see `nnir-imap-make-query' for
+details on the language and supported extensions"
   (require 'imap)
   (require 'nnimap)
   (save-excursion
@@ -908,11 +911,182 @@
                  (lambda (artnum)
                    (push (vector group artnum 1) artlist)
                    (setq arts (1+ arts)))
-                 (imap-search (concat criteria " \"" qstring "\"") buf))
+                 (imap-search (nnir-imap-make-query criteria qstring) buf))
                 (message "Searching %s... %d matches" mbx arts)))
             (message "Searching %s...done" group))
         (quit nil))
       (reverse artlist))))
+
+(defun nnir-imap-make-query (criteria qstring)
+  "Parse the query string and criteria into an appropriate IMAP search
+expression, returning the string query to make.
+
+This implements a little language designed to return the expected results
+to an arbitrary query string to the end user.
+
+The search is always case-insensitive, as defined by RFC2060, and supports
+the following features (inspired by the Google search input language): 
+
+Automatic \"and\" queries
+    If you specify multiple words then they will be treated as an \"and\"
+    expression intended to match all components.
+
+Phrase searches
+    If you wrap your query in double-quotes then it will be treated as a
+    literal string.
+
+Negative terms
+    If you precede a term with \"-\" then it will negate that.
+
+\"OR\" queries
+    If you include an upper-case \"OR\" in your search it will cause the
+    term before it and the term after it to be treated as alternatives.
+
+In future the following will be added to the language:
+ * support for date matches
+ * support for location of text matching within the query
+ * from/to/etc headers
+ * additional search terms
+ * flag based searching
+ * anything else that the RFC supports, basically."
+  ;; Walk through the query and turn it into an IMAP query string.
+  (nnir-imap-query-to-imap criteria (nnir-imap-parse-query qstring)))
+
+
+(defun nnir-imap-query-to-imap (criteria query)
+  "Turn a s-expression format query into IMAP."
+  (mapconcat
+   ;; Turn the expressions into IMAP text
+   (lambda (item)
+     (nnir-imap-expr-to-imap criteria item))
+   ;; The query, already in s-expr format.
+   query
+   ;; Append a space between each expression
+   " "))
+
+
+(defun nnir-imap-expr-to-imap (criteria expr)
+  "Convert EXPR into an IMAP search expression on CRITERIA"
+  ;; What sort of expression is this, eh?
+  (cond
+   ;; Simple string term
+   ((stringp expr)
+    (format "%s \"%s\"" criteria (imap-quote-specials expr)))
+   ;; Trivial term: and
+   ((eq expr 'and) nil)
+   ;; Composite term: or expression
+   ((eq (car-safe expr) 'or)
+    (format "OR %s %s"
+	    (nnir-imap-expr-to-imap criteria (second expr))
+	    (nnir-imap-expr-to-imap criteria (third expr))))
+   ;; Composite term: just the fax, mam
+   ((eq (car-safe expr) 'not)
+    (format "NOT (%s)" (nnir-imap-query-to-imap criteria (rest expr))))
+   ;; Composite term: just expand it all.
+   ((and (not (null expr)) (listp expr))
+    (format "(%s)" (nnir-imap-query-to-imap criteria expr)))
+   ;; Complex value, give up for now.
+   (t (error "Unhandled input: %S" expr))))
+
+
+(defun nnir-imap-parse-query (string)
+  "Turn STRING into an s-expression based query based on the IMAP
+query language as defined in `nnir-imap-make-query'.
+
+This involves turning individual tokens into higher level terms
+that the search language can then understand and use."
+  (with-temp-buffer
+    ;; Set up the parsing environment.
+    (insert string)
+    (goto-char (point-min))
+    ;; Now, collect the output terms and return them.
+    (let (out)
+      (while (not (nnir-imap-end-of-input))
+	(push (nnir-imap-next-expr) out))
+      (reverse out))))
+
+
+(defun nnir-imap-next-expr (&optional count)
+  "Return the next expression from the current buffer."
+  (let ((term (nnir-imap-next-term count))
+	(next (nnir-imap-peek-symbol)))
+    ;; Are we looking at an 'or' expression?
+    (cond
+     ;; Handle 'expr or expr'
+     ((eq next 'or)
+      (list 'or term (nnir-imap-next-expr 2)))
+     ;; Anything else
+     (t term))))
+
+
+(defun nnir-imap-next-term (&optional count)
+  "Return the next TERM from the current buffer."
+  (let ((term (nnir-imap-next-symbol count)))
+    ;; What sort of term is this?
+    (cond
+     ;; and -- just ignore it
+     ((eq term 'and) 'and)
+     ;; negated term
+     ((eq term 'not) (list 'not (nnir-imap-next-expr)))
+     ;; generic term
+     (t term))))
+
+
+(defun nnir-imap-peek-symbol ()
+  "Return the next symbol from the current buffer, but don't consume it."
+  (save-excursion
+    (nnir-imap-next-symbol)))
+
+(defun nnir-imap-next-symbol (&optional count)
+  "Return the next symbol from the current buffer, or nil if we are
+at the end of the buffer.  If supplied COUNT skips some symbols before
+returning the one at the supplied position."
+  (when (and (numberp count) (> count 1))
+    (nnir-imap-next-symbol (1- count)))
+  (let ((case-fold-search t))
+    ;; end of input stream?
+    (unless (nnir-imap-end-of-input)
+      ;; No, return the next symbol from the stream.
+      (cond
+       ;; negated expression -- return it and advance one char.
+       ((looking-at "-") (forward-char 1) 'not)
+       ;; quoted string
+       ((looking-at "\"") (nnir-imap-delimited-string "\""))
+       ;; list expression -- we parse the content and return this as a list.
+       ((looking-at "(")
+	(nnir-imap-parse-query (nnir-imap-delimited-string ")")))
+       ;; keyword input -- return a symbol version
+       ((looking-at "\\band\\b") (forward-char 3) 'and)
+       ((looking-at "\\bor\\b")  (forward-char 2) 'or)
+       ((looking-at "\\bnot\\b") (forward-char 3) 'not)
+       ;; Simple, boring keyword
+       (t (let ((start (point))
+		(end (if (search-forward-regexp "[[:blank:]]" nil t)
+			 (prog1
+			     (match-beginning 0)
+			   ;; unskip if we hit a non-blank terminal character.
+			   (when (string-match "[^[:blank:]]" (match-string 0))
+			     (backward-char 1)))
+		       (goto-char (point-max)))))
+	    (buffer-substring start end)))))))
+
+(defun nnir-imap-delimited-string (delimiter)
+  "Return a delimited string from the current buffer."
+  (let ((start (point)) end)
+    (forward-char 1)			; skip the first delimiter.
+    (while (not end)
+      (unless (search-forward delimiter nil t)
+	(error "Unmatched delimited input with %s in query" delimiter))
+      (let ((here (point)))
+	(unless (equal (buffer-substring (- here 2) (- here 1)) "\\")
+	  (setq end (point)))))
+    (buffer-substring (1+ start) (1- end))))
+
+(defun nnir-imap-end-of-input ()
+  "Are we at the end of input?"
+  (skip-chars-forward "[[:blank:]]")
+  (looking-at "$"))
+  
 
 ;; Swish++ interface.
 ;; -cc- Todo