Restore thread search behavior

* lisp/gnus/gnus-search.el (gnus-search-thread): Make this function
  produce an engine-agnostic search query.
  (gnus-search-prepare-query): Fix dumb error.
  (gnus-search-indexed-search-command): Edit to handle the 'thread
  key.
  (gnus-search-run-search): In thread searches, have the imap
  implementation expand Message-Id searches to include the References
  header. Also, somewhere along the way we lost the
  `gnus-search-get-active' call.
  (gnus-search-run-search): For Notmuch, add an :around method on this
  function, which does a primary search for thread-ids, then passes
  off to the secondary search for the messages themselves.
  (gnus-search-transform-expression): Forgot
  that multiple nested ORs have to be parenthesized for IMAP.
* lisp/gnus/nnselect.el (nnselect-request-thread): Alter function to
  pass in a generic thread search query; no longer calls imap-specific
  code.

diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index debd1f82a5a71a1a89b9dd7fb048d03ffd1125ad..e799374553c0c464183e5d01a9fcf7a2bbb96851 100644 (file)
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -1146,6 +1146,7 @@ Responsible for handling and, or, and parenthetical expressions.")
           (gnus-inhibit-demon t)
          ;; We're using the message id to look for a single message.
          (single-search (gnus-search-single-p query))
+         (grouplist (or groups (gnus-search-get-active srv)))
          q-string artlist group)
       (message "Opening server %s" server)
       ;; We should only be doing this once, in
@@ -1166,7 +1167,16 @@ Responsible for handling and, or, and parenthetical expressions.")
       (setq q-string
            (gnus-search-make-query-string engine query))
 
-      (while (and (setq group (pop groups))
+      ;; If it's a thread query, make sure that all message-id
+      ;; searches are also references searches.
+      (when (alist-get 'thread query)
+       (setq q-string
+             (replace-regexp-in-string
+              "HEADER Message-Id \\([^ )]+\\)"
+              "(OR HEADER Message-Id \\1 HEADER References \\1)"
+              q-string)))
+
+      (while (and (setq group (pop grouplist))
                  (or (null single-search) (null artlist)))
        (when (nnimap-change-group
               (gnus-group-short-name group) server)
@@ -1237,7 +1247,10 @@ Other capabilities could be tested here."
   (let ((left (gnus-search-transform-expression engine (nth 1 expr)))
        (right (gnus-search-transform-expression engine (nth 2 expr))))
     (if (and left right)
-       (format "OR %s %s" left right)
+       (format "(OR %s %s)"
+               left (format (if (eq 'or (car-safe (nth 2 expr)))
+                                "(%s)" "%s")
+                            right))
       (or left right))))
 
 (cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
@@ -1315,7 +1328,7 @@ boolean instead."
                  (upcase (symbol-name (car expr)))
                  (gnus-search-imap-handle-string engine (cdr expr))))
         ((eq (car expr) 'id)
-         (format "HEADER Message-ID %s" (cdr expr)))
+         (format "HEADER Message-ID \"%s\"" (cdr expr)))
         ;; Treat what can't be handled as a HEADER search.  Probably a bad
         ;; idea.
         (t (format "%sHEADER %s %s"
@@ -1692,22 +1705,58 @@ Namazu provides a little more information, for instance a score."
       (format "date:%s.." (notmuch-date (cdr expr))))
      (t (ignore-errors (cl-call-next-method))))))
 
+(cl-defmethod gnus-search-run-search :around ((engine gnus-search-notmuch)
+                                             server query groups)
+  "Handle notmuch's thread-search routine."
+  ;; Notmuch allows for searching threads, but only using its own
+  ;; thread ids.  That means a thread search is a \"double-bounce\":
+  ;; once to find the relevant thread ids, and again to find the
+  ;; actual messages.  This method performs the first \"bounce\".
+  (when (alist-get 'thread query)
+    (with-slots (program proc-buffer) engine
+      (let* ((qstring
+             (gnus-search-make-query-string engine query))
+            (cp-list (gnus-search-indexed-search-command
+                      engine qstring query groups))
+            thread-ids proc)
+       (set-buffer proc-buffer)
+       (erase-buffer)
+       (setq proc (apply #'start-process (format "search-%s" server)
+                         proc-buffer program cp-list))
+       (while (process-live-p proc)
+         (accept-process-output proc))
+       (while (re-search-forward "^thread:\\([^ ]+\\)" (point-max) t)
+         (push (match-string 1) thread-ids))
+       ;; All of the following is to make sure that the secondary
+       ;; search ignores the original search query, and instead uses
+       ;; our new thread query.
+       (setf (alist-get 'thread query) nil
+             (alist-get 'raw query) t
+             groups nil
+             (alist-get 'query query)
+             (mapconcat (lambda (thrd) (concat "thread:" thrd))
+                        thread-ids " or ")))))
+  (cl-call-next-method engine server query groups))
+
 (cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-notmuch)
                                                  (qstring string)
                                                  query &optional _groups)
   ;; Theoretically we could use the GROUPS parameter to pass a
   ;; --folder switch to notmuch, but I'm not confident of getting the
   ;; format right.
-  (let ((limit (alist-get 'limit query)))
-   (with-slots (switches config-file) engine
-     `(,(format "--config=%s" config-file)
-       "search"
-       "--output=files"
-       "--duplicate=1" ; I have found this necessary, I don't know why.
-       ,@switches
-       ,(if limit (format "--limit=%d" limit) "")
-       ,qstring
-       ))))
+  (let ((limit (alist-get 'limit query))
+       (thread (alist-get 'thread query)))
+    (with-slots (switches config-file) engine
+      `(,(format "--config=%s" config-file)
+       "search"
+       (if thread
+           "--output=threads"
+         "--output=files")
+       "--duplicate=1" ; I have found this necessary, I don't know why.
+       ,@switches
+       ,(if limit (format "--limit=%d" limit) "")
+       ,qstring
+       ))))
 
 ;;; Mairix interface
 
@@ -2086,7 +2135,7 @@ remaining string, then adds all that to the top-level spec."
        (setf (alist-get (intern (match-string 1 query)) query-spec)
              ;; This is stupid.
              (cond
-              ((eql val 't))
+              ((equal val "t"))
               ((null (zerop (string-to-number val)))
                (string-to-number val))
               (t val)))
@@ -2134,7 +2183,6 @@ remaining string, then adds all that to the top-level spec."
       (nnheader-message 5 "No search engine defined for %s" srv))
     inst))
 
-(autoload 'nnimap-make-thread-query "nnimap")
 (declare-function gnus-registry-get-id-key "gnus-registry" (id key))
 
 (defun gnus-search-thread (header)
@@ -2142,11 +2190,18 @@ remaining string, then adds all that to the top-level spec."
 header. The current server will be searched. If the registry is
 installed, the server that the registry reports the current
 article came from is also searched."
-  (let* ((query
-         (list (cons 'query (nnimap-make-thread-query header))))
+  (let* ((ids (cons (mail-header-id header)
+                   (split-string
+                    (or (mail-header-references header)
+                        ""))))
+        (query
+         (list (cons 'query (mapconcat (lambda (i)
+                                         (format "id:%s" i))
+                                       ids " or "))
+               (cons 'thread t)))
         (server
          (list (list (gnus-method-to-server
-          (gnus-find-method-for-group gnus-newsgroup-name)))))
+                      (gnus-find-method-for-group gnus-newsgroup-name)))))
         (registry-group (and
                          (bound-and-true-p gnus-registry-enabled)
                          (car (gnus-registry-get-id-key
@@ -2158,8 +2213,8 @@ article came from is also searched."
     (when registry-server
       (cl-pushnew (list registry-server) server :test #'equal))
     (gnus-group-make-search-group nil (list
-                                    (cons 'gnus-search-query-spec query)
-                                    (cons 'gnus-search-group-spec server)))
+                                      (cons 'search-query-spec query)
+                                      (cons 'search-group-spec server)))
     (gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header)))))
 
 (defun gnus-search-get-active (srv)

diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 7a51f7f05912e356c16452e45ee3518a03f69d16..4268fd12c6a91e5218ae273cda419575934528a6 100644 (file)
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1819,6 +1819,20 @@ If LIMIT, first try to limit the search to the N last articles."
                                  (cdr (assoc "SEARCH" (cdr result))))))
            nil t))))))
 
+(defun nnimap-make-thread-query (header)
+  (let* ((id  (mail-header-id header))
+        (refs (split-string
+               (or (mail-header-references header)
+                   "")))
+        (value
+         (format
+          "(OR HEADER REFERENCES %S HEADER Message-Id %S)"
+          id id)))
+    (dolist (refid refs value)
+      (setq value (format
+                  "(OR (OR HEADER Message-Id %S HEADER REFERENCES %S) %s)"
+                  refid refid value)))))
+
 (defun nnimap-change-group (group &optional server no-reconnect read-only)
   "Change group to GROUP if non-nil.
 If SERVER is set, check that server is connected, otherwise retry
@@ -2212,21 +2226,6 @@ Return the server's response to the SELECT or EXAMINE command."
                  group-art))
          nnimap-incoming-split-list)))
 
-(defun nnimap-make-thread-query (header)
-  (let* ((id  (mail-header-id header))
-        (refs (split-string
-               (or (mail-header-references header)
-                   "")))
-        (value
-         (format
-          "(OR HEADER References %S HEADER Message-Id %S)"
-          id id)))
-    (dolist (refid refs value)
-      (setq value (format
-                  "(OR (OR HEADER Message-Id %S HEADER References %S) %s)"
-                  refid refid value)))))
-
-
 (provide 'nnimap)
 
 ;;; nnimap.el ends here

diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index 2f2c9dd4c67ab79aeb7ab32cf8e83cf0c8c0bff0..d5b6b5bdfb5df7bbcb5050123630e7180e494354 100644 (file)
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -498,19 +498,27 @@ If this variable is nil, or if the provided function returns nil,
                             (cl-some #'(lambda (x)
                                          (when (and x (> x 0)) x))
                                      (gnus-articles-in-thread thread))))))))))
-    ;; Check if we are dealing with an imap backend.
-    (if (eq 'nnimap
-           (car (gnus-find-method-for-group artgroup)))
+    ;; Check if search-based thread referral is permitted, and
+    ;; possible.
+    (if (and gnus-refer-thread-use-search
+            (gnus-search-server-to-engine
+             (gnus-method-to-server
+              (gnus-find-method-for-group artgroup))))
        ;; If so we perform the query, massage the result, and return
        ;; the new headers back to the caller to incorporate into the
        ;; current summary buffer.
        (let* ((group-spec
                (list (delq nil (list
-                                (or server (gnus-group-server artgroup))
-                                (unless  gnus-refer-thread-use-search
-                                  artgroup)))))
+                                (or server (gnus-group-server artgroup))))))
+              (ids (cons (mail-header-id header)
+                         (split-string
+                          (or (mail-header-references header)
+                              ""))))
               (query-spec
-               (list (cons 'query (nnimap-make-thread-query header))))
+               (list (cons 'query (mapconcat (lambda (i)
+                                               (format "id:%s" i))
+                                             ids " or "))
+                     (cons 'thread t)))
               (last (nnselect-artlist-length gnus-newsgroup-selection))
               (first (1+ last))
               (new-nnselect-artlist
@@ -562,8 +570,8 @@ If this variable is nil, or if the provided function returns nil,
             group
             (cons 1 (nnselect-artlist-length gnus-newsgroup-selection))))
          headers)
-      ;; If not an imap backend just warp to the original article
-      ;; group and punt back to gnus-summary-refer-thread.
+      ;; If we can't or won't use search, just warp to the original
+      ;; article group and punt back to gnus-summary-refer-thread.
       (and (gnus-warp-to-article) (gnus-summary-refer-thread)))))
 
 
@@ -663,9 +671,15 @@ If this variable is nil, or if the provided function returns nil,
 The current server will be searched.  If the registry is
 installed, the server that the registry reports the current
 article came from is also searched."
-  (let* ((query
-         (list (cons 'query (nnimap-make-thread-query header))
-               (cons 'criteria "")))
+  (let* ((ids (cons (mail-header-id header)
+                   (split-string
+                    (or (mail-header-references header)
+                        ""))))
+        (query
+         (list (cons 'query (mapconcat (lambda (i)
+                                         (format "id:%s" i))
+                                       ids " or "))
+               (cons 'thread t)))
         (server
          (list (list (gnus-method-to-server
                       (gnus-find-method-for-group gnus-newsgroup-name)))))