Clean up group-finding in Gnus nnir search
This is part of removing code from nnir.el that isn't related to searching backends and therefore belongs somewhere else. * lisp/gnus/gnus-group.el (gnus-group-make-search-group) (gnus-group-read-ephemeral-search-group): Put the logic for determining the groups to search here, rather than in nnir. Improve documentation. * lisp/gnus/gnus-int.el (gnus-server-get-active): Renamed from 'nnir-get-active. * lisp/gnus/nnir.el (nnir-run-imap, nnir-run-find-grep): Use it. (nnir-get-active): Remove. (nnir-make-specs): Make obsolete. * lisp/gnus/nnselect.el (nnselect-group-server): Make obsolete in favor of 'gnus-group-server.
This commit is contained in:
Andrew G Cohen
parent
f7be259400
commit
206cff84bd
4 changed files with 149 additions and 85 deletions
|
|
@ -3166,30 +3166,13 @@ mail messages or news articles in files that have numeric names."
|
|||
(list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
|
||||
|
||||
|
||||
(autoload 'nnir-make-specs "nnir")
|
||||
(autoload 'nnir-read-parms "nnir")
|
||||
(autoload 'nnir-server-to-search-engine "nnir")
|
||||
(autoload 'gnus-group-topic-name "gnus-topic")
|
||||
|
||||
;; Temporary to make group creation easier
|
||||
(defun gnus-group-make-search-group (nnir-extra-parms &optional specs)
|
||||
(interactive "P")
|
||||
(let ((name (gnus-read-group "Group name: ")))
|
||||
(with-current-buffer gnus-group-buffer
|
||||
(gnus-group-make-group
|
||||
name
|
||||
(list 'nnselect "nnselect")
|
||||
nil
|
||||
(list
|
||||
(cons 'nnselect-specs
|
||||
(list
|
||||
(cons 'nnselect-function 'nnir-run-query)
|
||||
(cons 'nnselect-args
|
||||
(nnir-make-specs nnir-extra-parms specs)))))))))
|
||||
|
||||
(define-obsolete-function-alias 'gnus-group-make-nnir-group
|
||||
'gnus-group-read-ephemeral-search-group "28.1")
|
||||
|
||||
(defun gnus-group-read-ephemeral-search-group (nnir-extra-parms &optional specs)
|
||||
"Create an nnselect group based on a search.
|
||||
"Make a 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
|
||||
|
|
@ -3200,19 +3183,96 @@ 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")
|
||||
(gnus-group-read-ephemeral-group
|
||||
(concat "nnselect-" (message-unique-id))
|
||||
(list 'nnselect "nnselect")
|
||||
nil
|
||||
(cons (current-buffer) gnus-current-window-configuration)
|
||||
nil nil
|
||||
(list
|
||||
(cons 'nnselect-specs
|
||||
(list
|
||||
(cons 'nnselect-function 'nnir-run-query)
|
||||
(cons 'nnselect-args
|
||||
(nnir-make-specs nnir-extra-parms specs))))
|
||||
(cons 'nnselect-artlist nil))))
|
||||
(let ((name (gnus-read-group "Group name: ")))
|
||||
(with-current-buffer gnus-group-buffer
|
||||
(let* ((group-spec
|
||||
(or
|
||||
(cdr (assq 'nnir-group-spec specs))
|
||||
(if (gnus-server-server-name)
|
||||
(list (list (gnus-server-server-name)))
|
||||
(seq-group-by
|
||||
(lambda (elt) (gnus-group-server elt))
|
||||
(or gnus-group-marked
|
||||
(if (gnus-group-group-name)
|
||||
(list (gnus-group-group-name))
|
||||
(cdr
|
||||
(assoc (gnus-group-topic-name) gnus-topic-alist))))))))
|
||||
(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))))))
|
||||
(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)))))
|
||||
(cons 'nnselect-artlist nil)))))))
|
||||
|
||||
(define-obsolete-function-alias 'gnus-group-make-nnir-group
|
||||
'gnus-group-read-ephemeral-search-group "28.1")
|
||||
|
||||
(defun gnus-group-read-ephemeral-search-group (nnir-extra-parms &optional specs)
|
||||
"Read 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)))
|
||||
(seq-group-by
|
||||
(lambda (elt) (gnus-group-server elt))
|
||||
(or gnus-group-marked
|
||||
(if (gnus-group-group-name)
|
||||
(list (gnus-group-group-name))
|
||||
(cdr
|
||||
(assoc (gnus-group-topic-name) gnus-topic-alist))))))))
|
||||
(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))))))
|
||||
(gnus-group-read-ephemeral-group
|
||||
(concat "nnselect-" (message-unique-id))
|
||||
(list 'nnselect "nnselect")
|
||||
nil
|
||||
(cons (current-buffer) gnus-current-window-configuration)
|
||||
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)))))
|
||||
|
||||
(defun gnus-group-add-to-virtual (n vgroup)
|
||||
"Add the current group to a virtual group."
|
||||
|
|
|
|||
|
|
@ -365,6 +365,48 @@ If it is down, start it up (again)."
|
|||
(funcall (gnus-get-function gnus-command-method 'request-list)
|
||||
(nth 1 gnus-command-method)))
|
||||
|
||||
(defun gnus-server-get-active (server &optional ignored)
|
||||
"Return the active list for SERVER.
|
||||
Groups matching the IGNORED regexp are excluded."
|
||||
(let ((method (gnus-server-to-method server))
|
||||
groups)
|
||||
(gnus-request-list method)
|
||||
(with-current-buffer nntp-server-buffer
|
||||
(let ((cur (current-buffer)))
|
||||
(goto-char (point-min))
|
||||
(unless (or (null ignored)
|
||||
(string= ignored ""))
|
||||
(delete-matching-lines ignored))
|
||||
(if (eq (car method) 'nntp)
|
||||
(while (not (eobp))
|
||||
(ignore-errors
|
||||
(push (gnus-group-full-name
|
||||
(buffer-substring
|
||||
(point)
|
||||
(progn
|
||||
(skip-chars-forward "^ \t")
|
||||
(point)))
|
||||
method)
|
||||
groups))
|
||||
(forward-line))
|
||||
(while (not (eobp))
|
||||
(ignore-errors
|
||||
(push (if (eq (char-after) ?\")
|
||||
(gnus-group-full-name (read cur) method)
|
||||
(let ((p (point)) (name ""))
|
||||
(skip-chars-forward "^ \t\\\\")
|
||||
(setq name (buffer-substring p (point)))
|
||||
(while (eq (char-after) ?\\)
|
||||
(setq p (1+ (point)))
|
||||
(forward-char 2)
|
||||
(skip-chars-forward "^ \t\\\\")
|
||||
(setq name (concat name (buffer-substring
|
||||
p (point)))))
|
||||
(gnus-group-full-name name method)))
|
||||
groups))
|
||||
(forward-line)))))
|
||||
groups))
|
||||
|
||||
(defun gnus-finish-retrieve-group-infos (gnus-command-method infos data)
|
||||
"Read and update infos from GNUS-COMMAND-METHOD."
|
||||
(when (stringp gnus-command-method)
|
||||
|
|
|
|||
|
|
@ -549,6 +549,7 @@ construct the vector entries."
|
|||
|
||||
;;; Search Engine Interfaces:
|
||||
|
||||
(autoload 'gnus-server-get-active "gnus-int")
|
||||
(autoload 'nnimap-change-group "nnimap")
|
||||
(declare-function nnimap-buffer "nnimap" ())
|
||||
(declare-function nnimap-command "nnimap" (&rest args))
|
||||
|
|
@ -567,7 +568,8 @@ extensions."
|
|||
(cdr (assoc nnir-imap-default-search-key
|
||||
nnir-imap-search-arguments))))
|
||||
(gnus-inhibit-demon t)
|
||||
(groups (or groups (nnir-get-active srv))))
|
||||
(groups
|
||||
(or groups (gnus-server-get-active srv nnir-ignored-newsgroups))))
|
||||
(message "Opening server %s" server)
|
||||
(apply
|
||||
'vconcat
|
||||
|
|
@ -1205,7 +1207,8 @@ construct path: search terms (see the variable
|
|||
(directory (cadr (assoc sym (cddr method))))
|
||||
(regexp (cdr (assoc 'query query)))
|
||||
(grep-options (cdr (assoc 'grep-options query)))
|
||||
(grouplist (or grouplist (nnir-get-active server))))
|
||||
(grouplist
|
||||
(or grouplist (gnus-server-get-active server nnir-ignored-newsgroups))))
|
||||
(unless directory
|
||||
(error "No directory found in method specification of server %s"
|
||||
server))
|
||||
|
|
@ -1332,54 +1335,13 @@ environment unless NOT-GLOBAL is non-nil."
|
|||
((and (not not-global) (boundp key)) (symbol-value key))
|
||||
(t nil))))
|
||||
|
||||
(autoload 'gnus-request-list "gnus-int")
|
||||
|
||||
(defun nnir-get-active (srv)
|
||||
"Return the active list for SRV."
|
||||
(let ((method (gnus-server-to-method srv))
|
||||
groups)
|
||||
(gnus-request-list method)
|
||||
(with-current-buffer nntp-server-buffer
|
||||
(let ((cur (current-buffer)))
|
||||
(goto-char (point-min))
|
||||
(unless (or (null nnir-ignored-newsgroups)
|
||||
(string= nnir-ignored-newsgroups ""))
|
||||
(delete-matching-lines nnir-ignored-newsgroups))
|
||||
(if (eq (car method) 'nntp)
|
||||
(while (not (eobp))
|
||||
(ignore-errors
|
||||
(push (gnus-group-full-name
|
||||
(buffer-substring
|
||||
(point)
|
||||
(progn
|
||||
(skip-chars-forward "^ \t")
|
||||
(point)))
|
||||
method)
|
||||
groups))
|
||||
(forward-line))
|
||||
(while (not (eobp))
|
||||
(ignore-errors
|
||||
(push (if (eq (char-after) ?\")
|
||||
(gnus-group-full-name (read cur) method)
|
||||
(let ((p (point)) (name ""))
|
||||
(skip-chars-forward "^ \t\\\\")
|
||||
(setq name (buffer-substring p (point)))
|
||||
(while (eq (char-after) ?\\)
|
||||
(setq p (1+ (point)))
|
||||
(forward-char 2)
|
||||
(skip-chars-forward "^ \t\\\\")
|
||||
(setq name (concat name (buffer-substring
|
||||
p (point)))))
|
||||
(gnus-group-full-name name method)))
|
||||
groups))
|
||||
(forward-line)))))
|
||||
groups))
|
||||
|
||||
(autoload 'nnselect-categorize "nnselect" nil nil)
|
||||
(autoload 'gnus-group-topic-name "gnus-topic" nil nil)
|
||||
(defvar gnus-group-marked)
|
||||
(defvar gnus-topic-alist)
|
||||
|
||||
(make-obsolete 'nnir-make-specs "This function should no longer
|
||||
be used." "28.1")
|
||||
|
||||
(defun nnir-make-specs (nnir-extra-parms &optional specs)
|
||||
"Make the query-spec and group-spec for a search with NNIR-EXTRA-PARMS.
|
||||
Query for the specs, or use SPECS."
|
||||
|
|
@ -1387,12 +1349,12 @@ Query for the specs, or use SPECS."
|
|||
(or (cdr (assq 'nnir-group-spec specs))
|
||||
(if (gnus-server-server-name)
|
||||
(list (list (gnus-server-server-name)))
|
||||
(nnselect-categorize
|
||||
(seq-group-by
|
||||
(lambda (elt) (gnus-group-server elt))
|
||||
(or gnus-group-marked
|
||||
(if (gnus-group-group-name)
|
||||
(list (gnus-group-group-name))
|
||||
(cdr (assoc (gnus-group-topic-name) gnus-topic-alist))))
|
||||
'nnselect-group-server))))
|
||||
(cdr (assoc (gnus-group-topic-name) gnus-topic-alist))))))))
|
||||
(query-spec
|
||||
(or (cdr (assq 'nnir-query-spec specs))
|
||||
(apply
|
||||
|
|
@ -1407,6 +1369,8 @@ Query for the specs, or use SPECS."
|
|||
(list (cons 'nnir-query-spec query-spec)
|
||||
(cons 'nnir-group-spec group-spec))))
|
||||
|
||||
(define-obsolete-function-alias 'nnir-get-active 'gnus-server-get-active "28.1")
|
||||
|
||||
;; The end.
|
||||
(provide 'nnir)
|
||||
|
||||
|
|
|
|||
|
|
@ -105,9 +105,7 @@
|
|||
(gnus-uncompress-sequence artseq)) selection)))
|
||||
selection)))
|
||||
|
||||
(defun nnselect-group-server (group)
|
||||
"Return the server for GROUP."
|
||||
(gnus-group-server group))
|
||||
(make-obsolete 'nnselect-group-server 'gnus-group-server "28.1")
|
||||
|
||||
;; Data type article list.
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue