From: Eric Abrahamsen <eric@ericabrahamsen.net>
Date: Mon, 1 May 2017 19:31:55 +0000 (-0700)
Subject: Add function gnus-search-prepare-query
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=31514a043a700d03b5059e7120fc4e8d37185761;p=emacs.git

Add function gnus-search-prepare-query

* lisp/gnus/gnus-search.el (gnus-search-prepare-query): Check for
  "top-level" meta search keys and parse them into the query
  structure, alongside the query itself.
---

diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index f4923efee54..e2353a6e394 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -1852,32 +1852,71 @@ Returns a vector of [group name, file name, score] vectors."
   ;; search can be run in its own thread, allowing concurrent searches
   ;; of multiple backends.  At present this causes problems when
   ;; multiple IMAP servers are searched at the same time, apparently
-  ;; because the threads are somehow fighting for control, or the
-  ;; `nntp-server-buffer' variable is getting clobbered, or something
-  ;; else.
+  ;; because the `nntp-server-buffer' variable is getting clobbered,
+  ;; or something.  Anyway, that's the reason for the `mapc'.
   (let* ((results [])
 	 (q-spec (alist-get 'search-query-spec specs))
-	 (unparsed-query (alist-get 'query q-spec))
-	 (prepped-query (if (and gnus-search-use-parsed-queries
-				 (null (alist-get 'no-parse q-spec)))
-			    (gnus-search-parse-query unparsed-query)
-			  unparsed-query)))
+	 (query (alist-get 'query q-spec))
+	 ;; If the query is already a sexp, just leave it alone.
+	 (prepared-query (when (stringp query)
+			   (gnus-search-prepare-query q-spec))))
     (mapc
      (lambda (x)
        (let* ((server (car x))
 	      (search-engine (gnus-search-server-to-engine server))
-	      (groups (cadr x))
-	      (use-query (if (slot-value search-engine 'raw-queries-p)
-			     unparsed-query
-			   prepped-query)))
+	      (groups (cadr x)))
+	 ;; Give the search engine a chance to say it wants raw search
+	 ;; queries.  If SPECS was passed in with an already-parsed
+	 ;; query, that's tough luck for the engine.
+	 (setf (alist-get 'query prepared-query)
+	       (if (slot-value search-engine 'raw-queries-p)
+		   query
+		 (alist-get 'query prepared-query)))
 	 (setq results
 	       (vconcat
 		(gnus-search-run-search
-		 search-engine server use-query groups)
+		 search-engine server prepared-query groups)
 		results))))
      (alist-get 'search-group-spec specs))
     results))
 
+(defun gnus-search-prepare-query (query-spec)
+  "Accept a search query in raw format, and return a (possibly)
+  parsed version.
+
+QUERY-SPEC is an alist produced by functions such as
+`gnus-group-make-search-group', and contains at least a 'query
+key, and possibly some meta keys.  This function extracts any
+additional meta keys from the query, and optionally parses the
+string query into sexp form."
+  (let ((q-string (alist-get 'query query-spec))
+	key val)
+    ;; Look for these meta keys:
+    (while (string-match "\\(thread\\|limit\\|raw\\|no-parse\\|count\\):\\([^ ]+\\)" q-string)
+      ;; If they're found, push them into the query spec, and remove
+      ;; them from the query string.
+      (setq key (if (string= (match-string 1 q-string)
+			     "raw")
+		    ;; "raw" is a synonym for "no-parse".
+		    'no-parse
+		  (intern (match-string 1 q-string)))
+	    val (string-to-number (match-string 2 q-string)))
+      (push (cons key
+		  ;; A bit stupid, but right now the only possible
+		  ;; values are "t", or a number.
+		  (if (zerop val) t val))
+	    query-spec)
+      (setq q-string
+	    (string-trim (replace-match "" t t q-string 0))))
+    (setf (alist-get 'query query-spec) q-string)
+    ;; Decide whether to parse the query or not.
+    (setf (alist-get 'query query-spec)
+	  (if (and gnus-search-use-parsed-queries
+		   (null (alist-get 'no-parse query-spec)))
+	      (gnus-search-parse-query q-string)
+	    q-string))
+    query-spec))
+
 ;; This should be done once at Gnus startup time, when the servers are
 ;; first opened, and the resulting engine instance attached to the
 ;; server.