From 046785e5b77858b2dca464d620a1e95b89e23322 Mon Sep 17 00:00:00 2001 From: Andrew G Cohen Date: Fri, 12 May 2017 09:40:03 +0800 Subject: [PATCH] Redo entry functions for making search groups * lisp/gnus/gnus-group.el (gnus-group-make-search-group): (gnus-group-read-ephemeral-search-group): Rename these functions to be more consistent with other group creation functions, and move to gnus-group.el. * lisp/gnus/nnir.el (nnir-make-specs): Refactor new function to ease search group creation. --- lisp/gnus/gnus-group.el | 55 +++++++++++++++++++++++++++++---- lisp/gnus/nnir.el | 31 +++++++++++++++++++ lisp/gnus/nnselect.el | 67 ----------------------------------------- 3 files changed, 80 insertions(+), 73 deletions(-) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 3678abc4c5f..7f4822cc30f 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -49,9 +49,6 @@ (autoload 'gnus-agent-total-fetched-for "gnus-agent") (autoload 'gnus-cache-total-fetched-for "gnus-cache") -(autoload 'gnus-group-make-search-group "nnselect") -(autoload 'gnus-group-make-permanent-search-group "nnselect") - (autoload 'gnus-cloud-upload-all-data "gnus-cloud") (autoload 'gnus-cloud-download-all-data "gnus-cloud") @@ -672,8 +669,8 @@ simple manner." "D" gnus-group-enter-directory "f" gnus-group-make-doc-group "w" gnus-group-make-web-group - "G" gnus-group-make-search-group - "g" gnus-group-make-permanent-search-group + "G" gnus-group-read-ephemeral-search-group + "g" gnus-group-make-search-group "M" gnus-group-read-ephemeral-group "r" gnus-group-rename-group "R" gnus-group-make-rss-group @@ -919,8 +916,8 @@ simple manner." ["Add the help group" gnus-group-make-help-group t] ["Make a doc group..." gnus-group-make-doc-group t] ["Make a web group..." gnus-group-make-web-group t] + ["Read a search group..." gnus-group-read-ephemeral-search-group t] ["Make a search group..." gnus-group-make-search-group t] - ["Make a permanent search group..." gnus-group-make-permanent-search-group t] ["Make a virtual group..." gnus-group-make-empty-virtual t] ["Add a group to a virtual..." gnus-group-add-to-virtual t] ["Make an ephemeral group..." gnus-group-read-ephemeral-group t] @@ -3196,6 +3193,51 @@ mail messages or news articles in files that have numeric names." (gnus-group-real-name group) (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir))))) + +(autoload 'nnir-make-specs "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 (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 + (nnir-make-specs nnir-extra-parms specs)))))))) + +(defun gnus-group-read-ephemeral-search-group (nnir-extra-parms &optional specs) + "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") + (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 + (nnir-make-specs nnir-extra-parms specs)))) + (cons 'nnselect-artlist nil)))) + (defun gnus-group-add-to-virtual (n vgroup) "Add the current group to a virtual group." (interactive @@ -4731,6 +4773,7 @@ you the groups that have both dormant articles and cached articles." group 'expire (list article)))))) + ;;; ;;; Group compaction. -- dvl ;;; diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 673a99c226b..4c13a1b84ce 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -1369,6 +1369,37 @@ environment unless `not-global' is non-nil." (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) + +(defun nnir-make-specs (nnir-extra-parms &optional specs) + (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))) + (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)))) + 'nnselect-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)))))) + (list (cons 'nnir-query-spec query-spec) + (cons 'nnir-group-spec group-spec))))) + ;; The end. (provide 'nnir) diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index 1e02b6e516f..793775f9e10 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -793,73 +793,6 @@ originating groups." (declare-function gnus-registry-get-id-key "gnus-registry" (id key)) -(declare-function gnus-group-topic-name "gnus-topic" ()) - -;; 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)))) - 'nnselect-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)))))) (defun gnus-summary-make-search-group (nnir-extra-parms) "Search a group from the summary buffer." -- 2.39.5