lisp/gnus/nnir.el: Allow nnir group creation based on an existing query

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index e42e7606313a18a58991afc31f3d39d2b2774f84..3ea10f55df2c02ea8a27cf1055e2093f65f65a0c 100644 (file)
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,11 @@
+2013-03-29  Andrew Cohen  <cohen@bu.edu>
+
+       * nnir.el: Define 'number-sequence for xemacs.
+       (gnus-summary-create-nnir-group): New function to create an nnir group
+       from an nnir summary buffer based on the current query.
+       (nnir-request-create-group): Update to allow nnir group creation based
+       on the current query.
+
 2013-03-28  Katsumi Yamaoka  <yamaoka@jpl.org>
 
        * nndraft.el (nndraft-request-expire-articles):

diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index a48c6043e82de6f92f740f3a53509e579e02f1cd..cf9de09eaa24d778d14db9f7bdefabdcf2b5143a 100644 (file)
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -173,7 +173,15 @@
 
 ;; For Emacs <22.2 and XEmacs.
 (eval-and-compile
-  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
+  (unless (fboundp 'number-sequence)
+    (defun number-sequence (from to)
+      (let (seq (n 0) (next from))
+       (while (<= next to)
+         (setq seq (cons next seq)
+               n (1+ n)
+               next (+ from  n )))
+       (nreverse seq)))))
 
 (require 'nnoo)
 (require 'gnus-group)
@@ -1840,24 +1848,38 @@ article came from is also searched."
       (add-hook 'gnus-summary-article-expire-hook 'nnir-registry-action t t))))
 
 
+(defun gnus-summary-create-nnir-group ()
+  (interactive)
+  (let ((name (gnus-read-group "Group name: "))
+       (method "nnir")
+       (pgroup (if (gnus-group-prefixed-p gnus-newsgroup-name)
+                   gnus-newsgroup-name
+                 (gnus-group-prefixed-name
+                  gnus-newsgroup-name '(nnir "nnir")))))
+    (with-current-buffer gnus-group-buffer
+      (gnus-group-make-group
+       name method nil
+       (gnus-group-find-parameter pgroup)))))
+
 
 (deffoo nnir-request-create-group (group &optional server args)
   (message "Creating nnir group %s" group)
-  (let ((group (gnus-group-prefixed-name  group '(nnir "nnir")))
-       (query-spec
-         (list (cons 'query
-                     (read-string "Query: " nil 'nnir-search-history))))
-        (group-spec (list (list (read-string "Server: " nil nil)))))
-    (gnus-group-set-parameter
-     group 'nnir-specs
-     (list (cons 'nnir-query-spec query-spec)
-          (cons 'nnir-group-spec group-spec)))
+  (let* ((group (gnus-group-prefixed-name  group '(nnir "nnir")))
+         (specs (assoc 'nnir-specs args))
+         (query-spec
+          (or (cdr (assoc 'nnir-query-spec specs))
+              (list (cons 'query
+                          (read-string "Query: " nil 'nnir-search-history)))))
+         (group-spec
+          (or (cdr (assoc 'nnir-group-spec specs))
+              (list (list (read-string "Server: " nil nil)))))
+         (nnir-specs (list (cons 'nnir-query-spec query-spec)
+                           (cons 'nnir-group-spec group-spec))))
+    (gnus-group-set-parameter group 'nnir-specs nnir-specs)
     (gnus-group-set-parameter
      group 'nnir-artlist
-     (setq nnir-artlist
-          (nnir-run-query
-           (list (cons 'nnir-query-spec query-spec)
-                 (cons 'nnir-group-spec group-spec)))))
+     (or (cdr (assoc 'nnir-artlist args))
+         (nnir-run-query nnir-specs)))
     (nnir-request-update-info group (gnus-get-info group)))
   t)