[Emacs-diffs] scratch/gnus-search 63fab4a 3/4: Make related change to nnselect.el

[Eric Abrahamsen]

branch: scratch/gnus-search
commit 63fab4a02de8bcfbd4b17bc68efcd7d7511a4253
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    Make related change to nnselect.el
    
    Move *-make-search-group stuff to gnus-search.el
    
    Add an nnselect-summary-mode to nnselect.el
---
 lisp/gnus/nnselect.el | 145 +++++++++++++++++---------------------------------
 1 file changed, 49 insertions(+), 96 deletions(-)

diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index f0df535..0db4de2 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -36,10 +36,10 @@
 ;; sorting. Most functions will just chose a fixed number, such as
 ;; 100, for this score.
 
-;; For example the search function `nnir-run-query' applied to
-;; arguments specifying a search query (see "nnir.el") can be used to
-;; return a list of articles from a search. Or the function can be the
-;; identity and the args a vector of articles.
+;; For example the search function `gnus-search-run-query' applied to
+;; arguments specifying a search query (see "gnus-search.el") can be
+;; used to return a list of articles from a search. Or the function
+;; can be the identity and the args a vector of articles.
 
 
 ;;; Code:
@@ -71,8 +71,8 @@
 (defvar gnus-inhibit-demon)
 (defvar gnus-message-group-art)
 
-;; (defvar nnselect-artlist nil
-;;   "Internal: stores the list of articles.")
+(defvar nnselect-artlist nil
+  "Internal: stores the list of articles.")
 
 
 ;; For future use
@@ -289,13 +289,12 @@ If this variable is nil, or if the provided function 
returns nil,
         (when (eq 'nnimap (car (gnus-server-to-method server)))
           (let ((article article)
                (gnus-override-method (gnus-server-to-method server))
-                query)
-            (setq query
+                specs)
+            (setq specs
                   (list
-                   (cons 'query (format "HEADER Message-ID %s" article))
-                   (cons 'criteria "")
-                   (cons 'shortcut t)))
-            (setq nnselect-artlist (nnir-run-imap query server))
+                   (cons 'search-query-spec (list 'query '((id . ,article))))
+                  (cons 'search-group-spec (list server))))
+            (setq nnselect-artlist (gnus-search-run-query specs))
             (setq articleno 1)))
         (when to-buffer
           (set-buffer to-buffer))
@@ -465,7 +464,7 @@ If this variable is nil, or if the provided function 
returns nil,
                          (car art)))  artids))))))))
   (gnus-set-active group (cons 1 (nnselect-artlist-length nnselect-artlist))))
 
-(declare-function nnir-run-query "nnir" (specs))
+(declare-function gnus-search-run-query "gnus-search" (specs))
 (deffoo nnselect-request-thread (header &optional group server)
   (let ((group (nnselect-possibly-change-group group server))
        (artgroup (nnselect-article-group
@@ -492,14 +491,13 @@ If this variable is nil, or if the provided function 
returns nil,
                                 (unless  gnus-refer-thread-use-search
                                   (list artgroup))))))
               (query-spec
-               (list (cons 'query (nnimap-make-thread-query header))
-                     (cons 'criteria "")))
+               (list (cons 'query (nnimap-make-thread-query header))))
               (last (nnselect-artlist-length nnselect-artlist))
               (first (1+ last))
               (new-nnselect-artlist
-               (nnir-run-query
-                (list (cons 'nnir-query-spec query-spec)
-                      (cons 'nnir-group-spec group-spec))))
+               (gnus-search-run-query
+                (list (cons 'search-query-spec query-spec)
+                      (cons 'search-group-spec group-spec))))
               old-arts seq
               headers)
          ;; The search will likely find articles that are already
@@ -649,6 +647,9 @@ If this variable is nil, or if the provided function 
returns nil,
   (let ((backend (car (gnus-server-to-method server))))
     (nnoo-current-server-p (or backend 'nnselect) server)))
 
+
+(declare-function gnus-registry-get-id-key "gnus-registry"
+                  (id key))
 (defun nnselect-search-thread (header)
   "Make an nnselect group containing the thread with article HEADER.
 The current server will be searched.  If the registry is
@@ -659,7 +660,7 @@ article came from is also searched."
                (cons 'criteria "")))
         (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
@@ -680,10 +681,10 @@ article came from is also searched."
      (list
       (cons 'nnselect-specs
            (list
-            (cons 'nnselect-function 'nnir-run-query)
+            (cons 'nnselect-function 'gnus-search-run-query)
             (cons 'nnselect-args
-                  (list (cons 'nnir-query-spec query)
-                        (cons 'nnir-group-spec server)))))
+                  (list (cons 'search-query-spec query)
+                        (cons 'search-group-spec server)))))
       (cons 'nnselect-artlist nil)))
     (gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header)))))
 
@@ -766,80 +767,32 @@ originating groups."
           group-info (gnus-active artgroup) t)
          (gnus-group-update-group artgroup t))))))
 
-
-(declare-function gnus-registry-get-id-key "gnus-registry" (id key))
-(declare-function gnus-group-topic-name "gnus-topic" ())
-(declare-function nnir-read-parms "nnir" (search-engine))
-(declare-function nnir-server-to-search-engine "nnir" (server))
-
-
-;; Temporary to make group creation easier
-
-(defun gnus-group-make-permanent-search-group (nnir-extra-parms &optional 
specs)
-  (interactive "P")
-  (gnus-group-make-search-group nnir-extra-parms specs t))
-
-(defun gnus-group-make-search-group (nnir-extra-parms &optional specs perm)
-  "Create an nnselect group based on a search.  Prompt for a
-search query and determine the groups to search as follows: if
-called from the *Server* buffer search all groups belonging to
-the server on the current line; if called from the *Group* buffer
-search any marked groups, or the group on the current line, or
-all the groups under the current topic. Calling with a prefix-arg
-prompts for additional search-engine specific constraints. A
-non-nil `specs' arg must be an alist with `nnir-query-spec' and
-`nnir-group-spec' keys, and skips all prompting."
-  (interactive "P")
-  (let* ((group-spec
-         (or (cdr (assq 'nnir-group-spec specs))
-           (if (gnus-server-server-name)
-               (list (list (gnus-server-server-name)))
-             (nnselect-categorize
-              (or gnus-group-marked
-                  (if (gnus-group-group-name)
-                      (list (gnus-group-group-name))
-                    (cdr (assoc (gnus-group-topic-name) gnus-topic-alist))))
-              gnus-group-server))))
-        (query-spec
-         (or (cdr (assq 'nnir-query-spec specs))
-           (apply
-            'append
-            (list (cons 'query
-                        (read-string "Query: " nil 'nnir-search-history)))
-            (when nnir-extra-parms
-              (mapcar
-               (lambda (x)
-                 (nnir-read-parms (nnir-server-to-search-engine (car x))))
-               group-spec))))))
-    (if perm
-       (let ((name (read-string "Group name: " nil)))
-         (gnus-group-make-group
-          name
-          (list 'nnselect "nnselect")
-          nil
-          (list
-           (cons 'nnselect-specs
-                 (list
-                  (cons 'nnselect-function 'nnir-run-query)
-                  (cons 'nnselect-args
-                        (list (cons 'nnir-query-spec query-spec)
-                              (cons 'nnir-group-spec group-spec))))))))
-      (gnus-group-read-ephemeral-group
-       (concat "nnselect-" (message-unique-id))
-       (list 'nnselect "nnselect")
-       nil
-       (cons (current-buffer) gnus-current-window-configuration)
-                                       ;     nil
-       nil nil
-       (list
-       (cons 'nnselect-specs
-             (list
-              (cons 'nnselect-function 'nnir-run-query)
-              (cons 'nnselect-args
-                    (list (cons 'nnir-query-spec query-spec)
-                          (cons 'nnir-group-spec group-spec)))))
-       (cons 'nnselect-artlist nil))))))
-
+;;; Derived summary mode for nnselect groups
+
+(declare-function gnus-registry-action "gnus-registry"
+                  (action data-header from &optional to method))
+
+(defun nnselect-registry-redirect (action data-header _from &optional to 
method)
+  "Call `gnus-registry-action' with the original article group."
+  (gnus-registry-action
+   action
+   data-header
+   (nnselect-article-group (mail-header-number data-header))
+   to
+   method))
+
+;; Currently unused.
+(defun nnselect-mode ()
+  "A variant of Gnus' summary mode, for nnselect virtual groups."
+  (setq gnus-summary-line-format
+       (or nnselect-summary-line-format gnus-summary-line-format))
+  (when (bound-and-true-p gnus-registry-enabled)
+    (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-redirect t)
+    (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-redirect t)
+    (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-redirect t)
+    (add-hook 'gnus-summary-article-delete-hook 'nnselect-registry-redirect t 
t)
+    (add-hook 'gnus-summary-article-move-hook 'nnselect-registry-redirect t t)
+    (add-hook 'gnus-summary-article-expire-hook 'nnselect-registry-redirect t 
t)))
 
 ;; The end.
 (provide 'nnselect)