procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source
This commit is contained in:
Andrew Cohen 2013-03-29 14:12:58 +00:00 • committed by Katsumi Yamaoka
parent 75a2f98113
commit d406cffa8e
2 changed files with 44 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
lisp/gnus/ChangeLog
View file

@ -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):

50
lisp/gnus/nnir.el
View file

@ -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)