[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] scratch/gnus-search 63fab4a 3/4: Make related change to nn
From: |
Eric Abrahamsen |
Subject: |
[Emacs-diffs] scratch/gnus-search 63fab4a 3/4: Make related change to nnselect.el |
Date: |
Wed, 26 Apr 2017 18:30:50 -0400 (EDT) |
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)