diff options
Diffstat (limited to 'lisp/gnus/nnir.el')
| -rw-r--r-- | lisp/gnus/nnir.el | 1360 |
1 files changed, 640 insertions, 720 deletions
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 14d1abd5bb..0fc00770c8 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -32,163 +32,41 @@ ;; TODO: Documentation in the Gnus manual -;; From: Reiner Steib -;; Subject: Re: Including nnir.el -;; Newsgroups: gmane.emacs.gnus.general -;; Message-ID: <v9d5dnp6aq.fsf@marauder.physik.uni-ulm.de> -;; Date: 2006-06-05 22:49:01 GMT -;; -;; On Sun, Jun 04 2006, Sascha Wilde wrote: -;; -;; > The one thing most hackers like to forget: Documentation. By now the -;; > documentation is only in the comments at the head of the source, I -;; > would use it as basis to cook up some minimal texinfo docs. -;; > -;; > Where in the existing gnus manual would this fit best? - -;; Maybe (info "(gnus)Combined Groups") for a general description. -;; `gnus-group-make-nnir-group' might be described in (info -;; "(gnus)Foreign Groups") as well. - - -;; The most recent version of this can always be fetched from the Gnus -;; repository. See http://www.gnus.org/ for more information. - -;; This code is still in the development stage but I'd like other -;; people to have a look at it. Please do not hesitate to contact me -;; with your ideas. +;; Where in the existing gnus manual would this fit best? -;; What does it do? Well, it allows you to index your mail using some -;; search engine (freeWAIS-sf, swish-e and others -- see later), -;; then type `G G' in the Group buffer and issue a query to the search -;; engine. You will then get a buffer which shows all articles -;; matching the query, sorted by Retrieval Status Value (score). +;; What does it do? Well, it allows you to search your mail using +;; some search engine (imap, namazu, swish-e, gmane and others -- see +;; later) by typing `G G' in the Group buffer. You will then get a +;; buffer which shows all articles matching the query, sorted by +;; Retrieval Status Value (score). ;; When looking at the retrieval result (in the Summary buffer) you -;; can type `G T' (aka M-x gnus-summary-nnir-goto-thread RET) on an -;; article. You will be teleported into the group this article came -;; from, showing the thread this article is part of. (See below for -;; restrictions.) - -;; The Lisp installation is simple: just put this file on your -;; load-path, byte-compile it, and load it from ~/.gnus or something. -;; This will install a new command `G G' in your Group buffer for -;; searching your mail. Note that you also need to configure a number -;; of variables, as described below. - -;; Restrictions: -;; -;; * If you don't use HyREX as your search engine, this expects that -;; you use nnml or another one-file-per-message backend, because the -;; others doesn't support nnfolder. -;; * It can only search the mail backend's which are supported by one -;; search engine, because of different query languages. -;; * There are restrictions to the Wais setup. -;; * There are restrictions to the imap setup. -;; * gnus-summary-nnir-goto-thread: Fetches whole group first, before -;; limiting to the right articles. This is much too slow, of -;; course. May issue a query for number of articles to fetch; you -;; must accept the default of all articles at this point or things -;; may break. - -;; The Lisp setup involves setting a few variables and setting up the +;; can type `A W' (aka M-x gnus-warp-to-article RET) on an article. You +;; will be warped into the group this article came from. Typing `A T' +;; (aka M-x gnus-summary-refer-thread RET) will warp to the group and +;; also show the thread this article is part of. + +;; The Lisp setup may involve setting a few variables and setting up the ;; search engine. You can define the variables in the server definition ;; like this : ;; (setq gnus-secondary-select-methods '( ;; (nnimap "" (nnimap-address "localhost") -;; (nnir-search-engine hyrex) -;; (nnir-hyrex-additional-switches ("-d" "ddl-nnimap.xml")) +;; (nnir-search-engine namazu) ;; ))) -;; Or you can define the global ones. The variables set in the mailer- -;; definition will be used first. -;; The variable to set is `nnir-search-engine'. Choose one of the engines -;; listed in `nnir-engines'. (Actually `nnir-engines' is an alist, -;; type `C-h v nnir-engines RET' for more information; this includes -;; examples for setting `nnir-search-engine', too.) -;; -;; The variable nnir-mail-backend isn't used anymore. -;; +;; The main variable to set is `nnir-search-engine'. Choose one of +;; the engines listed in `nnir-engines'. (Actually `nnir-engines' is +;; an alist, type `C-h v nnir-engines RET' for more information; this +;; includes examples for setting `nnir-search-engine', too.) -;; You must also set up a search engine. I'll tell you about the two -;; search engines currently supported: +;; If you use one of the local indices (namazu, find-grep, swish) you +;; must also set up a search engine backend. -;; 1. freeWAIS-sf -;; -;; As always with freeWAIS-sf, you need a so-called `format file'. I -;; use the following file: -;; -;; ,----- -;; | # Kai's format file for freeWAIS-sf for indexing mails. -;; | # Each mail is in a file, much like the MH format. -;; | -;; | # Document separator should never match -- each file is a document. -;; | record-sep: /^@this regex should never match@$/ -;; | -;; | # Searchable fields specification. -;; | -;; | region: /^[sS]ubject:/ /^[sS]ubject: */ -;; | subject "Subject header" stemming TEXT BOTH -;; | end: /^[^ \t]/ -;; | -;; | region: /^([tT][oO]|[cC][cC]):/ /^([tT][oO]|[cC][cC]): */ -;; | to "To and Cc headers" SOUNDEX BOTH -;; | end: /^[^ \t]/ -;; | -;; | region: /^[fF][rR][oO][mM]:/ /^[fF][rR][oO][mM]: */ -;; | from "From header" SOUNDEX BOTH -;; | end: /^[^ \t]/ -;; | -;; | region: /^$/ -;; | stemming TEXT GLOBAL -;; | end: /^@this regex should never match@$/ -;; `----- -;; -;; 1998-07-22: waisindex would dump core on me for large articles with -;; the above settings. I used /^$/ as the end regex for the global -;; field. That seemed to work okay. - -;; There is a Perl module called `WAIS.pm' which is available from -;; CPAN as well as ls6-ftp.cs.uni-dortmund.de:/pub/wais/Perl. This -;; module comes with a nifty tool called `makedb', which I use for -;; indexing. Here's my `makedb.conf': -;; -;; ,----- -;; | # Config file for makedb -;; | -;; | # Global options -;; | waisindex = /usr/local/bin/waisindex -;; | wais_opt = -stem -t fields -;; | # `-stem' option necessary when `stemming' is specified for the -;; | # global field in the *.fmt file -;; | -;; | # Own variables -;; | homedir = /home/kai -;; | -;; | # The mail database. -;; | database = mail -;; | files = `find $homedir/Mail -name \*[0-9] -print` -;; | dbdir = $homedir/.wais -;; | limit = 100 -;; `----- -;; -;; The Lisp setup involves the `nnir-wais-*' variables. The most -;; difficult to understand variable is probably -;; `nnir-wais-remove-prefix'. Here's what it does: the output of -;; `waissearch' basically contains the file name and the (full) -;; directory name. As Gnus works with group names rather than -;; directory names, the directory name is transformed into a group -;; name as follows: first, a prefix is removed from the (full) -;; directory name, then all `/' are replaced with `.'. The variable -;; `nnir-wais-remove-prefix' should contain a regex matching exactly -;; this prefix. It defaults to `$HOME/Mail/' (note the trailing -;; slash). - -;; 2. Namazu +;; 1. Namazu ;; ;; The Namazu backend requires you to have one directory containing all ;; index files, this is controlled by the `nnir-namazu-index-directory' ;; variable. To function the `nnir-namazu-remove-prefix' variable must -;; also be correct, see the documentation for `nnir-wais-remove-prefix' +;; also be correct, see the documentation for `nnir-namazu-remove-prefix' ;; above. ;; ;; It is particularly important not to pass any any switches to namazu @@ -227,18 +105,7 @@ ;; For maximum searching efficiency I have a cron job set to run this ;; command every four hours. -;; 3. HyREX -;; -;; The HyREX backend requires you to have one directory from where all -;; your relative paths are to, if you use them. This directory must be -;; set in the `nnir-hyrex-index-directory' variable, which defaults to -;; your home directory. You must also pass the base, class and -;; directory options or simply your dll to the `nnir-hyrex-programm' by -;; setting the `nnir-hyrex-additional-switches' variable accordently. -;; To function the `nnir-hyrex-remove-prefix' variable must also be -;; correct, see the documentation for `nnir-wais-remove-prefix' above. - -;; 4. find-grep +;; 2. find-grep ;; ;; The find-grep engine simply runs find(1) to locate eligible ;; articles and searches them with grep(1). This, of course, is much @@ -263,10 +130,10 @@ ;; I have tried to make the code expandable. Basically, it is divided ;; into two layers. The upper layer is somewhat like the `nnvirtual' -;; or `nnkiboze' backends: given a specification of what articles to -;; show from another backend, it creates a group containing exactly -;; those articles. The lower layer issues a query to a search engine -;; and produces such a specification of what articles to show from the +;; backend: given a specification of what articles to show from +;; another backend, it creates a group containing exactly those +;; articles. The lower layer issues a query to a search engine and +;; produces such a specification of what articles to show from the ;; other backend. ;; The interface between the two layers consists of the single @@ -294,177 +161,187 @@ ;; function should return the list of articles as a vector, as ;; described above. Then, you need to register this backend in ;; `nnir-engines'. Then, users can choose the backend by setting -;; `nnir-search-engine'. - -;; Todo, or future ideas: +;; `nnir-search-engine' as a server variable. -;; * It should be possible to restrict search to certain groups. -;; -;; * There is currently no error checking. -;; -;; * The summary buffer display is currently really ugly, with all the -;; added information in the subjects. How could I make this -;; prettier? -;; -;; * A function which can be called from an nnir summary buffer which -;; teleports you into the group the current article came from and -;; shows you the whole thread this article is part of. -;; Implementation suggestions? -;; (1998-07-24: There is now a preliminary implementation, but -;; it is much too slow and quite fragile.) -;; -;; * Support other mail backends. In particular, probably quite a few -;; people use nnfolder. How would one go about searching nnfolders -;; and producing the right data needed? The group name and the RSV -;; are simple, but what about the article number? -;; - The article number is encoded in the `X-Gnus-Article-Number' -;; header of each mail. -;; - The HyREX engine supports nnfolder. -;; -;; * Support compressed mail files. Probably, just stripping off the -;; `.gz' or `.Z' file name extension is sufficient. -;; -;; * At least for imap, the query is performed twice. -;; +;;; Code: -;; Have you got other ideas? +;;; Setup: -;;; Setup Code: +;; For Emacs <22.2 and XEmacs. +(eval-and-compile + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (require 'nnoo) (require 'gnus-group) -(require 'gnus-sum) (require 'message) (require 'gnus-util) (eval-when-compile (require 'cl)) -(nnoo-declare nnir) -(nnoo-define-basics nnir) +;;; Internal Variables: -(gnus-declare-backend "nnir" 'mail) +(defvar nnir-current-query nil + "Internal: stores current query (= group name).") + +(defvar nnir-current-server nil + "Internal: stores current server (does it ever change?).") + +(defvar nnir-current-group-marked nil + "Internal: stores current list of process-marked groups.") + +(defvar nnir-artlist nil + "Internal: stores search result.") + +(defvar nnir-tmp-buffer " *nnir*" + "Internal: temporary buffer.") + +(defvar nnir-search-history () + "Internal: the history for querying search options in nnir") -(defvar nnir-imap-search-field "TEXT" - "The IMAP search item when doing an nnir search") +(defvar nnir-extra-parms nil + "Internal: stores request for extra search parms") + +;; Imap variables (defvar nnir-imap-search-arguments '(("Whole message" . "TEXT") ("Subject" . "SUBJECT") ("To" . "TO") ("From" . "FROM") - (nil . "HEADER \"%s\"")) - "Mapping from user readable strings to IMAP search items for use in nnir") + ("Imap" . "")) + "Mapping from user readable keys to IMAP search items for use in nnir") + +(defvar nnir-imap-search-other "HEADER %S" + "The IMAP search item to use for anything other than + `nnir-imap-search-arguments'. By default this is the name of an + email header field") (defvar nnir-imap-search-argument-history () "The history for querying search options in nnir") -;;; Developer Extension Variable: +;;; Helper macros -(defvar nnir-engines - `((wais nnir-run-waissearch - ()) - (imap nnir-run-imap - ((criteria - "Search in: " ; Prompt - ,nnir-imap-search-arguments ; alist for completing - nil ; no filtering - nil ; allow any user input - nil ; initial value - nnir-imap-search-argument-history ; the history to use - ,nnir-imap-search-field ; default - ))) - (swish++ nnir-run-swish++ - ((group . "Group spec: "))) - (swish-e nnir-run-swish-e - ((group . "Group spec: "))) - (namazu nnir-run-namazu - ()) - (hyrex nnir-run-hyrex - ((group . "Group spec: "))) - (find-grep nnir-run-find-grep - ((grep-options . "Grep options: ")))) - "Alist of supported search engines. -Each element in the alist is a three-element list (ENGINE FUNCTION ARGS). -ENGINE is a symbol designating the searching engine. FUNCTION is also -a symbol, giving the function that does the search. The third element -ARGS is a list of cons pairs (PARAM . PROMPT). When issuing a query, -the FUNCTION will issue a query for each of the PARAMs, using PROMPT. +;; Data type article list. -The value of `nnir-search-engine' must be one of the ENGINE symbols. -For example, use the following line for searching using freeWAIS-sf: - (setq nnir-search-engine 'wais) -Use the following line if you read your mail via IMAP and your IMAP -server supports searching: - (setq nnir-search-engine 'imap) -Note that you have to set additional variables for most backends. For -example, the `wais' backend needs the variables `nnir-wais-program', -`nnir-wais-database' and `nnir-wais-remove-prefix'. +(defmacro nnir-artlist-length (artlist) + "Returns number of articles in artlist." + `(length ,artlist)) + +(defmacro nnir-artlist-article (artlist n) + "Returns from ARTLIST the Nth artitem (counting starting at 1)." + `(when (> ,n 0) + (elt ,artlist (1- ,n)))) + +(defmacro nnir-artitem-group (artitem) + "Returns the group from the ARTITEM." + `(elt ,artitem 0)) + +(defmacro nnir-artitem-number (artitem) + "Returns the number from the ARTITEM." + `(elt ,artitem 1)) + +(defmacro nnir-artitem-rsv (artitem) + "Returns the Retrieval Status Value (RSV, score) from the ARTITEM." + `(elt ,artitem 2)) + +(defmacro nnir-article-group (article) + "Returns the group for ARTICLE" + `(nnir-artitem-group (nnir-artlist-article nnir-artlist ,article))) + +(defmacro nnir-article-number (article) + "Returns the number for ARTICLE" + `(nnir-artitem-number (nnir-artlist-article nnir-artlist ,article))) + +(defmacro nnir-article-rsv (article) + "Returns the rsv for ARTICLE" + `(nnir-artitem-rsv (nnir-artlist-article nnir-artlist ,article))) + +(defsubst nnir-article-ids (article) + "Returns the pair `(nnir id . real id)' of ARTICLE" + (cons article (nnir-article-number article))) + +(defmacro nnir-categorize (sequence keyfunc &optional valuefunc) + "Sorts a sequence into categories and returns a list of the form +`((key1 (element11 element12)) (key2 (element21 element22))'. +The category key for a member of the sequence is obtained +as `(keyfunc member)' and the corresponding element is just +`member'. If `valuefunc' is non-nil, the element of the list +is `(valuefunc member)'." + `(unless (null ,sequence) + (let (value) + (mapc + (lambda (member) + (let ((y (,keyfunc member)) + (x ,(if valuefunc + `(,valuefunc member) + 'member))) + (if (assoc y value) + (push x (cadr (assoc y value))) + (push (list y (list x)) value)))) + ,sequence) + value))) + +;;; Finish setup: + +(require 'gnus-sum) + +(eval-when-compile + (autoload 'nnimap-buffer "nnimap") + (autoload 'nnimap-command "nnimap") + (autoload 'nnimap-possibly-change-group "nnimap") + (autoload 'gnus-registry-action "gnus-registry") + (defvar gnus-registry-install)) + + +(nnoo-declare nnir) +(nnoo-define-basics nnir) + +(gnus-declare-backend "nnir" 'mail) -Add an entry here when adding a new search engine.") ;;; User Customizable Variables: (defgroup nnir nil - "Search nnmh and nnml groups in Gnus with swish-e, freeWAIS-sf, or EWS." + "Search groups in Gnus with assorted seach engines." :group 'gnus) -;; Mail backend. - -;; TODO: -;; If `nil', use server parameters to find out which server to search. CCC -;; -(defcustom nnir-mail-backend '(nnml "") - "*Specifies which backend should be searched. -More precisely, this is used to determine from which backend to fetch the -messages found. - -This must be equal to an existing server, so maybe it is best to use -something like the following: - (setq nnir-mail-backend (nth 0 gnus-secondary-select-methods)) -The above line works fine if the mail backend you want to search is -the first element of gnus-secondary-select-methods (`nth' starts counting -at zero)." - :type '(sexp) +(defcustom nnir-ignored-newsgroups "" + "*A regexp to match newsgroups in the active file that should + be skipped when searching." + :type '(regexp) :group 'nnir) -;; Search engine to use. +(defcustom nnir-summary-line-format nil + "*The format specification of the lines in an nnir summary buffer. -(defcustom nnir-search-engine 'wais - "*The search engine to use. Must be a symbol. -See `nnir-engines' for a list of supported engines, and for example -settings of `nnir-search-engine'." - :type '(sexp) - :group 'nnir) +All the items from `gnus-summary-line-format' are available, along +with three items unique to nnir summary buffers: -;; freeWAIS-sf. +%Z Search retrieval score value (integer) +%G Article original full group name (string) +%g Article original short group name (string) -(defcustom nnir-wais-program "waissearch" - "*Name of waissearch executable." +If nil this will use `gnus-summary-line-format'." :type '(string) :group 'nnir) -(defcustom nnir-wais-database (expand-file-name "~/.wais/mail") - "*Name of Wais database containing the mail. +(defcustom nnir-retrieve-headers-override-function nil + "*If non-nil, a function that accepts an article list and group +and populates the `nntp-server-buffer' with the retrieved +headers. Must return either 'nov or 'headers indicating the +retrieved header format. -Note that this should be a file name without extension. For example, -if you have a file /home/john/.wais/mail.fmt, use this: - (setq nnir-wais-database \"/home/john/.wais/mail\") -The string given here is passed to `waissearch -d' as-is." - :type '(file) +If this variable is nil, or if the provided function returns nil for a search +result, `gnus-retrieve-headers' will be called instead." + :type '(function) :group 'nnir) -(defcustom nnir-wais-remove-prefix (concat (getenv "HOME") "/Mail/") - "*The prefix to remove from each directory name returned by waissearch -in order to get a group name (albeit with / instead of .). This is a -regular expression. - -For example, suppose that Wais returns file names such as -\"/home/john/Mail/mail/misc/42\". For this example, use the following -setting: (setq nnir-wais-remove-prefix \"/home/john/Mail/\") -Note the trailing slash. Removing this prefix gives \"mail/misc/42\". -`nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to -arrive at the correct group name, \"mail.misc\"." - :type '(regexp) +(defcustom nnir-imap-default-search-key "Whole message" + "*The default IMAP search key for an nnir search. Must be one of + the keys in `nnir-imap-search-arguments'. To use raw imap queries + by default set this to \"Imap\"." + :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) + nnir-imap-search-arguments)) :group 'nnir) (defcustom nnir-swish++-configuration-file @@ -493,14 +370,13 @@ Instead, use this: in order to get a group name (albeit with / instead of .). This is a regular expression. -This variable is very similar to `nnir-wais-remove-prefix', except -that it is for swish++, not Wais." +This variable is very similar to `nnir-namazu-remove-prefix', except +that it is for swish++, not Namazu." :type '(regexp) :group 'nnir) ;; Swish-E. -;; URL: http://sunsite.berkeley.edu/SWISH-E/ -;; New version: http://www.boe.es/swish-e +;; URL: http://swish-e.org/ ;; Variables `nnir-swish-e-index-file', `nnir-swish-e-program' and ;; `nnir-swish-e-additional-switches' @@ -545,8 +421,8 @@ This could be a server parameter." in order to get a group name (albeit with / instead of .). This is a regular expression. -This variable is very similar to `nnir-wais-remove-prefix', except -that it is for swish-e, not Wais. +This variable is very similar to `nnir-namazu-remove-prefix', except +that it is for swish-e, not Namazu. This could be a server parameter." :type '(regexp) @@ -586,7 +462,7 @@ arrive at the correct group name, \"mail.misc\"." :type '(directory) :group 'nnir) -;; Namazu engine, see <URL:http://ww.namazu.org/> +;; Namazu engine, see <URL:http://www.namazu.org/> (defcustom nnir-namazu-program "namazu" "*Name of Namazu search executable." @@ -614,118 +490,97 @@ Instead, use this: "*The prefix to remove from each file name returned by Namazu in order to get a group name (albeit with / instead of .). -This variable is very similar to `nnir-wais-remove-prefix', except -that it is for Namazu, not Wais." +For example, suppose that Namazu returns file names such as +\"/home/john/Mail/mail/misc/42\". For this example, use the following +setting: (setq nnir-namazu-remove-prefix \"/home/john/Mail/\") +Note the trailing slash. Removing this prefix gives \"mail/misc/42\". +`nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to +arrive at the correct group name, \"mail.misc\"." :type '(directory) :group 'nnir) -;;; Internal Variables: - -(defvar nnir-current-query nil - "Internal: stores current query (= group name).") - -(defvar nnir-current-server nil - "Internal: stores current server (does it ever change?).") +;;; Developer Extension Variable: -(defvar nnir-current-group-marked nil - "Internal: stores current list of process-marked groups.") +(defvar nnir-engines + `((imap nnir-run-imap + ((criteria + "Imap Search in" ; Prompt + ,(mapcar 'car nnir-imap-search-arguments) ; alist for completing + nil ; allow any user input + nil ; initial value + nnir-imap-search-argument-history ; the history to use + ,nnir-imap-default-search-key ; default + ))) + (gmane nnir-run-gmane + ((author . "Gmane Author: "))) + (swish++ nnir-run-swish++ + ((group . "Swish++ Group spec: "))) + (swish-e nnir-run-swish-e + ((group . "Swish-e Group spec: "))) + (namazu nnir-run-namazu + ()) + (hyrex nnir-run-hyrex + ((group . "Hyrex Group spec: "))) + (find-grep nnir-run-find-grep + ((grep-options . "Grep options: ")))) + "Alist of supported search engines. +Each element in the alist is a three-element list (ENGINE FUNCTION ARGS). +ENGINE is a symbol designating the searching engine. FUNCTION is also +a symbol, giving the function that does the search. The third element +ARGS is a list of cons pairs (PARAM . PROMPT). When issuing a query, +the FUNCTION will issue a query for each of the PARAMs, using PROMPT. -(defvar nnir-artlist nil - "Internal: stores search result.") +The value of `nnir-search-engine' must be one of the ENGINE symbols. +For example, for searching a server using namazu include + (nnir-search-engine namazu) +in the server definition. Note that you have to set additional +variables for most backends. For example, the `namazu' backend +needs the variables `nnir-namazu-program', +`nnir-namazu-index-directory' and `nnir-namazu-remove-prefix'. -(defvar nnir-tmp-buffer " *nnir*" - "Internal: temporary buffer.") +Add an entry here when adding a new search engine.") -;;; Code: +(defcustom nnir-method-default-engines + '((nnimap . imap) + (nntp . gmane)) + "*Alist of default search engines keyed by server method." + :type `(repeat (cons (choice (const nnimap) (const nttp) (const nnspool) + (const nneething) (const nndir) (const nnmbox) + (const nnml) (const nnmh) (const nndraft) + (const nnfolder) (const nnmaildir)) + (choice + ,@(mapcar (lambda (elem) (list 'const (car elem))) + nnir-engines)))) + :group 'nnir) ;; Gnus glue. -(defun gnus-group-make-nnir-group (extra-parms query) +(defun gnus-group-make-nnir-group (nnir-extra-parms) "Create an nnir group. Asks for query." - (interactive "P\nsQuery: ") + (interactive "P") (setq nnir-current-query nil nnir-current-server nil nnir-current-group-marked nil nnir-artlist nil) - (let ((parms nil)) - (if extra-parms - (setq parms (nnir-read-parms query)) - (setq parms (list (cons 'query query)))) + (let* ((query (read-string "Query: " nil 'nnir-search-history)) + (parms (list (cons 'query query))) + (srv (if (gnus-server-server-name) + "all" ""))) (add-to-list 'parms (cons 'unique-id (message-unique-id)) t) (gnus-group-read-ephemeral-group - (concat "nnir:" (prin1-to-string parms)) '(nnir "") t - (cons (current-buffer) - gnus-current-window-configuration) + (concat "nnir:" (prin1-to-string parms)) (list 'nnir srv) t + (cons (current-buffer) gnus-current-window-configuration) nil))) -(eval-when-compile - (when (featurep 'xemacs) - ;; The `kbd' macro requires that the `read-kbd-macro' macro is available. - (require 'edmacro))) - -(defun nnir-group-mode-hook () - (define-key gnus-group-mode-map (kbd "G G") - 'gnus-group-make-nnir-group)) -(add-hook 'gnus-group-mode-hook 'nnir-group-mode-hook) - -;; Why is this needed? Is this for compatibility with old/new gnusae? Using -;; gnus-group-server instead works for me. -- Justus Piater -(defmacro nnir-group-server (group) - "Return the server for a newsgroup GROUP. -The returned format is as `gnus-server-to-method' needs it. See -`gnus-group-real-prefix' and `gnus-group-real-name'." - `(let ((gname ,group)) - (if (string-match "^\\([^:]+\\):" gname) - (progn - (setq gname (match-string 1 gname)) - (if (string-match "^\\([^+]+\\)\\+\\(.+\\)$" gname) - (format "%s:%s" (match-string 1 gname) (match-string 2 gname)) - (concat gname ":"))) - (format "%s:%s" (car gnus-select-method) (cadr gnus-select-method))))) - -;; Summary mode commands. - -(defun gnus-summary-nnir-goto-thread () - "Only applies to nnir groups. Go to group this article came from -and show thread that contains this article." - (interactive) - (unless (eq 'nnir (car (gnus-find-method-for-group gnus-newsgroup-name))) - (error "Can't execute this command unless in nnir group")) - (let* ((cur (gnus-summary-article-number)) - (group (nnir-artlist-artitem-group nnir-artlist cur)) - (backend-number (nnir-artlist-artitem-number nnir-artlist cur)) - server backend-group) - (setq server (nnir-group-server group)) - (setq backend-group (gnus-group-real-name group)) - (gnus-group-read-ephemeral-group - backend-group - (gnus-server-to-method server) - t ; activate - (cons (current-buffer) - 'summary) ; window config - nil - (list backend-number)) - (gnus-summary-limit (list backend-number)) - (gnus-summary-refer-thread))) - -(if (fboundp 'eval-after-load) - (eval-after-load "gnus-sum" - '(define-key gnus-summary-goto-map - "T" 'gnus-summary-nnir-goto-thread)) - (add-hook 'gnus-summary-mode-hook - (function (lambda () - (define-key gnus-summary-goto-map - "T" 'gnus-summary-nnir-goto-thread))))) - - ;; Gnus backend interface functions. (deffoo nnir-open-server (server &optional definitions) ;; Just set the server variables appropriately. + (add-hook 'gnus-summary-mode-hook 'nnir-mode) (nnoo-change-server 'nnir server definitions)) -(deffoo nnir-request-group (group &optional server fast) +(deffoo nnir-request-group (group &optional server fast info) "GROUP is the query string." (nnir-possibly-change-server server) ;; Check for cache and return that if appropriate. @@ -735,111 +590,140 @@ and show thread that contains this article." (equal server nnir-current-server))) nnir-artlist ;; Cache miss. - (setq nnir-artlist (nnir-run-query group))) - (save-excursion - (set-buffer nntp-server-buffer) + (setq nnir-artlist (nnir-run-query group server))) + (with-current-buffer nntp-server-buffer + (setq nnir-current-query group) + (when server (setq nnir-current-server server)) + (setq nnir-current-group-marked gnus-group-marked) (if (zerop (length nnir-artlist)) - (progn - (setq nnir-current-query nil - nnir-current-server nil - nnir-current-group-marked nil - nnir-artlist nil) - (nnheader-report 'nnir "Search produced empty results.")) + (nnheader-report 'nnir "Search produced empty results.") ;; Remember data for cache. - (setq nnir-current-query group) - (when server (setq nnir-current-server server)) - (setq nnir-current-group-marked gnus-group-marked) (nnheader-insert "211 %d %d %d %s\n" (nnir-artlist-length nnir-artlist) ; total # 1 ; first # (nnir-artlist-length nnir-artlist) ; last # - group)))) ; group name + group)))) ; group name (deffoo nnir-retrieve-headers (articles &optional group server fetch-old) - (save-excursion - (let ((artlist (copy-sequence articles)) - art artitem artgroup artno artrsv artfullgroup - novitem novdata foo server) - (while (not (null artlist)) - (setq art (car artlist)) - (or (numberp art) - (nnheader-report - 'nnir - "nnir-retrieve-headers doesn't grok message ids: %s" - art)) - (setq artitem (nnir-artlist-article nnir-artlist art)) - (setq artrsv (nnir-artitem-rsv artitem)) - (setq artfullgroup (nnir-artitem-group artitem)) - (setq artno (nnir-artitem-number artitem)) - (setq artgroup (gnus-group-real-name artfullgroup)) - (setq server (nnir-group-server artfullgroup)) - ;; retrieve NOV or HEAD data for this article, transform into - ;; NOV data and prepend to `novdata' - (set-buffer nntp-server-buffer) - (nnir-possibly-change-server server) - (let ((gnus-override-method - (gnus-server-to-method server))) - (case (setq foo (gnus-retrieve-headers (list artno) artfullgroup nil)) + (with-current-buffer nntp-server-buffer + (let ((gnus-inhibit-demon t) + (articles-by-group (nnir-categorize + articles nnir-article-group nnir-article-ids)) + headers) + (while (not (null articles-by-group)) + (let* ((group-articles (pop articles-by-group)) + (artgroup (car group-articles)) + (articleids (cadr group-articles)) + (artlist (sort (mapcar 'cdr articleids) '<)) + (server (gnus-group-server artgroup)) + (gnus-override-method (gnus-server-to-method server)) + parsefunc) + ;; (or (numberp art) + ;; (nnheader-report + ;; 'nnir + ;; "nnir-retrieve-headers doesn't grok message ids: %s" + ;; art)) + (nnir-possibly-change-server server) + ;; is this needed? + (erase-buffer) + (case (setq gnus-headers-retrieved-by + (or + (and + nnir-retrieve-headers-override-function + (funcall nnir-retrieve-headers-override-function + artlist artgroup)) + (gnus-retrieve-headers artlist artgroup nil))) (nov - (goto-char (point-min)) - (setq novitem (nnheader-parse-nov)) - (unless novitem - (pop-to-buffer nntp-server-buffer) - (error - "nnheader-parse-nov returned nil for article %s in group %s" - artno artfullgroup))) + (setq parsefunc 'nnheader-parse-nov)) (headers - (goto-char (point-min)) - (setq novitem (nnheader-parse-head)) - (unless novitem - (pop-to-buffer nntp-server-buffer) - (error - "nnheader-parse-head returned nil for article %s in group %s" - artno artfullgroup))) - (t (error "Unknown header type %s while requesting article %s of group %s" - foo artno artfullgroup)))) - ;; replace article number in original group with article number - ;; in nnir group - (mail-header-set-number novitem art) - (mail-header-set-from novitem - (mail-header-from novitem)) - (mail-header-set-subject - novitem - (format "[%d: %s/%d] %s" - artrsv artgroup artno - (mail-header-subject novitem))) - ;;-(mail-header-set-extra novitem nil) - (push novitem novdata) - (setq artlist (cdr artlist))) - (setq novdata (nreverse novdata)) - (set-buffer nntp-server-buffer) (erase-buffer) - (mapc 'nnheader-insert-nov novdata) + (setq parsefunc 'nnheader-parse-head)) + (t (error "Unknown header type %s while requesting articles \ + of group %s" gnus-headers-retrieved-by artgroup))) + (goto-char (point-min)) + (while (not (eobp)) + (let* ((novitem (funcall parsefunc)) + (artno (mail-header-number novitem)) + (art (car (rassq artno articleids)))) + (when art + (mail-header-set-number novitem art) + (push novitem headers)) + (forward-line 1))))) + (setq headers + (sort headers + (lambda (x y) + (< (mail-header-number x) (mail-header-number y))))) + (erase-buffer) + (mapc 'nnheader-insert-nov headers) 'nov))) -(deffoo nnir-request-article (article - &optional group server to-buffer) +(deffoo nnir-request-article (article &optional group server to-buffer) (if (stringp article) (nnheader-report 'nnir "nnir-retrieve-headers doesn't grok message ids: %s" article) (save-excursion - (let* ((artitem (nnir-artlist-article nnir-artlist - article)) - (artfullgroup (nnir-artitem-group artitem)) - (artno (nnir-artitem-number artitem)) - ;; Bug? - ;; Why must we bind nntp-server-buffer here? It won't - ;; work if `buf' is used, say. (Of course, the set-buffer - ;; line below must then be updated, too.) - (nntp-server-buffer (or to-buffer nntp-server-buffer))) - (set-buffer nntp-server-buffer) - (erase-buffer) + (let ((artfullgroup (nnir-article-group article)) + (artno (nnir-article-number article))) (message "Requesting article %d from group %s" artno artfullgroup) - (gnus-request-article artno artfullgroup nntp-server-buffer) + (if to-buffer + (with-current-buffer to-buffer + (let ((gnus-article-decode-hook nil)) + (gnus-request-article-this-buffer artno artfullgroup))) + (gnus-request-article artno artfullgroup)) (cons artfullgroup artno))))) +(deffoo nnir-request-move-article (article group server accept-form + &optional last internal-move-group) + (let* ((artfullgroup (nnir-article-group article)) + (artno (nnir-article-number article)) + (to-newsgroup (nth 1 accept-form)) + (to-method (gnus-find-method-for-group to-newsgroup)) + (from-method (gnus-find-method-for-group artfullgroup)) + (move-is-internal (gnus-server-equal from-method to-method))) + (unless (gnus-check-backend-function + 'request-move-article artfullgroup) + (error "The group %s does not support article moving" artfullgroup)) + (gnus-request-move-article + artno + artfullgroup + (nth 1 from-method) + accept-form + last + (and move-is-internal + to-newsgroup ; Not respooling + (gnus-group-real-name to-newsgroup))))) + +(deffoo nnir-request-expire-articles (articles group &optional server force) + (if force + (let ((articles-by-group (nnir-categorize + articles nnir-article-group nnir-article-ids)) + not-deleted) + (while (not (null articles-by-group)) + (let* ((group-articles (pop articles-by-group)) + (artgroup (car group-articles)) + (articleids (cadr group-articles)) + (artlist (sort (mapcar 'cdr articleids) '<))) + (unless (gnus-check-backend-function 'request-expire-articles + artgroup) + (error "The group %s does not support article deletion" artgroup)) + (unless (gnus-check-server (gnus-find-method-for-group artgroup)) + (error "Couldn't open server for group %s" artgroup)) + (push (gnus-request-expire-articles + artlist artgroup force) + not-deleted))) + (sort (delq nil not-deleted) '<)) + articles)) + +(deffoo nnir-warp-to-article () + (let* ((cur (if (> (gnus-summary-article-number) 0) + (gnus-summary-article-number) + (error "This is not a real article."))) + (gnus-newsgroup-name (nnir-article-group cur)) + (backend-number (nnir-article-number cur))) + (gnus-summary-read-group-1 gnus-newsgroup-name t t gnus-summary-buffer + nil (list backend-number)))) (nnoo-define-skeleton nnir) @@ -866,7 +750,9 @@ ready to be added to the list of search results." (when (file-readable-p (concat prefix dirnam article)) ;; remove trailing slash and, for nnmaildir, cur/new/tmp (setq dirnam - (substring dirnam 0 (if (string= server "nnmaildir:") -5 -1))) + (substring dirnam 0 + (if (string= (gnus-group-server server) "nnmaildir") + -5 -1))) ;; Set group to dirnam without any leading dots or slashes, ;; and with all subsequent slashes replaced by dots @@ -874,8 +760,8 @@ ready to be added to the list of search results." (gnus-replace-in-string dirnam "^[./\\]" "" t) "[/\\]" "." t))) - (vector (nnir-group-full-name group server) - (if (string= server "nnmaildir:") + (vector (gnus-group-full-name group server) + (if (string= (gnus-group-server server) "nnmaildir") (nnmaildir-base-name-to-article-number (substring article 0 (string-match ":" article)) group nil) @@ -884,94 +770,50 @@ ready to be added to the list of search results." ;;; Search Engine Interfaces: -;; freeWAIS-sf interface. -(defun nnir-run-waissearch (query server &optional group) - "Run given query agains waissearch. Returns vector of (group name, file name) -pairs (also vectors, actually)." - (when group - (error "The freeWAIS-sf backend cannot search specific groups")) - (save-excursion - (let ((qstring (cdr (assq 'query query))) - (prefix (nnir-read-server-parm 'nnir-wais-remove-prefix server)) - artlist score artno dirnam) - (set-buffer (get-buffer-create nnir-tmp-buffer)) - (erase-buffer) - (message "Doing WAIS query %s..." query) - (call-process nnir-wais-program - nil ; input from /dev/null - t ; output to current buffer - nil ; don't redisplay - "-d" (nnir-read-server-parm 'nnir-wais-database server) ; database to search - qstring) - (message "Massaging waissearch output...") - ;; remove superfluous lines - (keep-lines "Score:") - ;; extract data from result lines - (goto-char (point-min)) - (while (re-search-forward - "Score: +\\([0-9]+\\).*'\\([0-9]+\\) +\\([^']+\\)/'" nil t) - (setq score (match-string 1) - artno (match-string 2) - dirnam (match-string 3)) - (unless (string-match prefix dirnam) - (nnheader-report 'nnir "Dir name %s doesn't contain prefix %s" - dirnam prefix)) - (setq group (gnus-replace-in-string - (replace-match "" t t dirnam) "/" ".")) - (push (vector (nnir-group-full-name group server) - (string-to-number artno) - (string-to-number score)) - artlist)) - (message "Massaging waissearch output...done") - (apply 'vector - (sort artlist - (function (lambda (x y) - (> (nnir-artitem-rsv x) - (nnir-artitem-rsv y))))))))) - -;; IMAP interface. -;; todo: -;; nnir invokes this two (2) times???! -;; we should not use nnimap at all but open our own server connection -;; we should not LIST * but use nnimap-list-pattern from defs -;; send queries as literals -;; handle errors - -(autoload 'nnimap-open-server "nnimap") -(defvar nnimap-server-buffer) ;; nnimap.el -(autoload 'imap-mailbox-select "imap") -(autoload 'imap-search "imap") -(autoload 'imap-quote-specials "imap") - -(defun nnir-run-imap (query srv &optional group-option) +;; imap interface +(defun nnir-run-imap (query srv &optional groups) "Run a search against an IMAP back-end server. This uses a custom query language parser; see `nnir-imap-make-query' for details on the language and supported extensions" (save-excursion (let ((qstring (cdr (assq 'query query))) - (server (cadr (gnus-server-to-method srv))) - (group (or group-option (gnus-group-group-name))) - (defs (caddr (gnus-server-to-method srv))) - (criteria (or (cdr (assq 'criteria query)) - nnir-imap-search-field)) - artlist buf) + (server (cadr (gnus-server-to-method srv))) + (defs (caddr (gnus-server-to-method srv))) + (criteria (or (cdr (assq 'criteria query)) + (cdr (assoc nnir-imap-default-search-key + nnir-imap-search-arguments)))) + (gnus-inhibit-demon t) + (groups (or groups (nnir-get-active srv)))) (message "Opening server %s" server) - (condition-case () - (when (nnimap-open-server server defs) ;; xxx - (setq buf nnimap-server-buffer) ;; xxx - (message "Searching %s..." group) - (let ((arts 0) - (mbx (gnus-group-real-name group))) - (when (imap-mailbox-select mbx nil buf) - (mapc - (lambda (artnum) - (push (vector group artnum 1) artlist) - (setq arts (1+ arts))) - (imap-search (nnir-imap-make-query criteria qstring) buf)) - (message "Searching %s... %d matches" mbx arts))) - (message "Searching %s...done" group)) - (quit nil)) - (reverse artlist)))) + (apply + 'vconcat + (mapcar + (lambda (group) + (let (artlist) + (condition-case () + (when (nnimap-possibly-change-group + (gnus-group-short-name group) server) + (with-current-buffer (nnimap-buffer) + (message "Searching %s..." group) + (let ((arts 0) + (result (nnimap-command "UID SEARCH %s" + (if (string= criteria "") + qstring + (nnir-imap-make-query + criteria qstring))))) + (mapc + (lambda (artnum) + (let ((artn (string-to-number artnum))) + (when (> artn 0) + (push (vector group artn 100) + artlist) + (setq arts (1+ arts))))) + (and (car result) (cdr (assoc "SEARCH" (cdr result))))) + (message "Searching %s... %d matches" group arts))) + (message "Searching %s...done" group)) + (quit nil)) + (nreverse artlist))) + groups))))) (defun nnir-imap-make-query (criteria qstring) "Parse the query string and criteria into an appropriate IMAP search @@ -1027,7 +869,7 @@ In future the following will be added to the language: (cond ;; Simple string term ((stringp expr) - (format "%s \"%s\"" criteria (imap-quote-specials expr))) + (format "%s %S" criteria expr)) ;; Trivial term: and ((eq expr 'and) nil) ;; Composite term: or expression @@ -1161,8 +1003,8 @@ actually). Tested with swish++ 4.7 on GNU/Linux and with swish++ 5.0b2 on Windows NT 4.0." - (when group - (error "The swish++ backend cannot search specific groups")) + ;; (when group + ;; (error "The swish++ backend cannot search specific groups")) (save-excursion (let ( (qstring (cdr (assq 'query query))) @@ -1173,7 +1015,7 @@ Windows NT 4.0." ;; is sufficient. Note that we can't only use the value of ;; nnml-use-compressed-files because old articles might have been ;; saved with a different value. - (article-pattern (if (string= server "nnmaildir:") + (article-pattern (if (string= (gnus-group-server server) "nnmaildir") ":[0-9]+" "^[0-9]+\\(\\.[a-z0-9]+\\)?$")) score artno dirnam filenam) @@ -1250,8 +1092,8 @@ actually). Tested with swish-e-2.0.1 on Windows NT 4.0." ;; swish-e crashes with empty parameter to "-w" on commandline... - (when group - (error "The swish-e backend cannot search specific groups")) + ;; (when group + ;; (error "The swish-e backend cannot search specific groups")) (save-excursion (let ((qstring (cdr (assq 'query query))) @@ -1321,7 +1163,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." ;; Windows "\\" -> "." (setq group (gnus-replace-in-string group "\\\\" ".")) - (push (vector (nnir-group-full-name group server) + (push (vector (gnus-group-full-name group server) (string-to-number artno) (string-to-number score)) artlist)))) @@ -1343,19 +1185,13 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." (qstring (cdr (assq 'query query))) (prefix (nnir-read-server-parm 'nnir-hyrex-remove-prefix server)) score artno dirnam) - (when (and group groupspec) - (error (concat "It does not make sense to use a group spec" - " with process-marked groups."))) - (when group - (setq groupspec (gnus-group-real-name group))) - (when (and group (not (equal group (nnir-group-full-name groupspec server)))) - (message "%s vs. %s" group (nnir-group-full-name groupspec server)) - (error "Server with groupspec doesn't match group !")) + (when (and (not groupspec) group) + (setq groupspec + (regexp-opt + (mapcar (lambda (x) (gnus-group-real-name x)) group)))) (set-buffer (get-buffer-create nnir-tmp-buffer)) (erase-buffer) - (if groupspec - (message "Doing hyrex-search query %s on %s..." query groupspec) - (message "Doing hyrex-search query %s..." query)) + (message "Doing hyrex-search query %s..." query) (let* ((cp-list `( ,nnir-hyrex-program nil ; input from /dev/null @@ -1377,16 +1213,14 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." ;; the user wants it. (when (> gnus-verbose 6) (display-buffer nnir-tmp-buffer)))) ;; FIXME: Dont clear buffer ! - (if groupspec - (message "Doing hyrex-search query \"%s\" on %s...done" qstring groupspec) - (message "Doing hyrex-search query \"%s\"...done" qstring)) + (message "Doing hyrex-search query \"%s\"...done" qstring) (sit-for 0) ;; nnir-search returns: ;; for nnml/nnfolder: "filename mailid weigth" ;; for nnimap: "group mailid weigth" (goto-char (point-min)) (delete-non-matching-lines "^\\S + [0-9]+ [0-9]+$") - ;; HyREX couldn't search directly in groups -- so filter out here. + ;; HyREX doesn't search directly in groups -- so filter out here. (when groupspec (keep-lines groupspec)) ;; extract data from result lines @@ -1398,7 +1232,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." score (match-string 3)) (when (string-match prefix dirnam) (setq dirnam (replace-match "" t t dirnam))) - (push (vector (nnir-group-full-name + (push (vector (gnus-group-full-name (gnus-replace-in-string dirnam "/" ".") server) (string-to-number artno) (string-to-number score)) @@ -1420,10 +1254,10 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." pairs (also vectors, actually). Tested with Namazu 2.0.6 on a GNU/Linux system." - (when group - (error "The Namazu backend cannot search specific groups")) + ;; (when group + ;; (error "The Namazu backend cannot search specific groups")) (save-excursion - (let ((article-pattern (if (string= server "nnmaildir:") + (let ((article-pattern (if (string= (gnus-group-server server) "nnmaildir") ":[0-9]+" "^[0-9]+$")) artlist @@ -1483,7 +1317,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (> (nnir-artitem-rsv x) (nnir-artitem-rsv y))))))))) -(defun nnir-run-find-grep (query server &optional group) +(defun nnir-run-find-grep (query server &optional grouplist) "Run find and grep to obtain matching articles." (let* ((method (gnus-server-to-method server)) (sym (intern @@ -1491,73 +1325,138 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (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))) artlist) (unless directory (error "No directory found in method specification of server %s" server)) - (message "Searching %s using find-grep..." (or group server)) - (save-window-excursion - (set-buffer (get-buffer-create nnir-tmp-buffer)) - (erase-buffer) - (if (> gnus-verbose 6) - (pop-to-buffer (current-buffer))) - (cd directory) ; Using relative paths simplifies postprocessing. - (let ((group - (if (not group) - "." - ;; Try accessing the group literally as well as - ;; interpreting dots as directory separators so the - ;; engine works with plain nnml as well as the Gnus Cache. - (let ((group (gnus-group-real-name group))) - ;; Replace cl-func find-if. - (if (file-directory-p group) - group - (if (file-directory-p - (setq group (gnus-replace-in-string group "\\." "/" t))) - group)))))) - (unless group - (error "Cannot locate directory for group")) - (save-excursion - (apply - 'call-process "find" nil t - "find" group "-type" "f" "-name" "[0-9]*" "-exec" - "grep" - `("-l" ,@(and grep-options - ;; Note: the 3rd arg of `split-string' is not - ;; available in Emacs 21. - (delete "" (split-string grep-options "\\s-"))) - "-e" ,regexp "{}" "+")))) - - ;; Translate relative paths to group names. - (while (not (eobp)) - (let* ((path (delete - "" - (split-string - (buffer-substring (point) (line-end-position)) "/"))) - (art (string-to-number (car (last path))))) - (while (string= "." (car path)) - (setq path (cdr path))) - (let ((group (mapconcat 'identity - ;; Replace cl-func: (subseq path 0 -1) - (let ((end (1- (length path))) - res) - (while (>= (setq end (1- end)) 0) - (push (pop path) res)) - (nreverse res)) - "."))) - (push (vector (nnir-group-full-name group server) art 0) - artlist)) - (forward-line 1))) - (message "Searching %s using find-grep...done" (or group server)) - artlist))) + (apply + 'vconcat + (mapcar (lambda (x) + (let ((group x)) + (message "Searching %s using find-grep..." + (or group server)) + (save-window-excursion + (set-buffer (get-buffer-create nnir-tmp-buffer)) + (erase-buffer) + (if (> gnus-verbose 6) + (pop-to-buffer (current-buffer))) + (cd directory) ; Using relative paths simplifies + ; postprocessing. + (let ((group + (if (not group) + "." + ;; Try accessing the group literally as + ;; well as interpreting dots as directory + ;; separators so the engine works with + ;; plain nnml as well as the Gnus Cache. + (let ((group (gnus-group-real-name group))) + ;; Replace cl-func find-if. + (if (file-directory-p group) + group + (if (file-directory-p + (setq group + (gnus-replace-in-string + group + "\\." "/" t))) + group)))))) + (unless group + (error "Cannot locate directory for group")) + (save-excursion + (apply + 'call-process "find" nil t + "find" group "-type" "f" "-name" "[0-9]*" "-exec" + "grep" + `("-l" ,@(and grep-options + (split-string grep-options "\\s-" t)) + "-e" ,regexp "{}" "+")))) + + ;; Translate relative paths to group names. + (while (not (eobp)) + (let* ((path (split-string + (buffer-substring + (point) + (line-end-position)) "/" t)) + (art (string-to-number (car (last path))))) + (while (string= "." (car path)) + (setq path (cdr path))) + (let ((group (mapconcat 'identity + ;; Replace cl-func: + ;; (subseq path 0 -1) + (let ((end (1- (length path))) + res) + (while + (>= (setq end (1- end)) 0) + (push (pop path) res)) + (nreverse res)) + "."))) + (push + (vector (gnus-group-full-name group server) art 0) + artlist)) + (forward-line 1))) + (message "Searching %s using find-grep...done" + (or group server)) + artlist))) + grouplist)))) + +(declare-function mm-url-insert "mm-url" (url &optional follow-refresh)) +(declare-function mm-url-encode-www-form-urlencoded "mm-url" (pairs)) + +;; gmane interface +(defun nnir-run-gmane (query srv &optional groups) + "Run a search against a gmane back-end server." + (let* ((case-fold-search t) + (qstring (cdr (assq 'query query))) + (server (cadr (gnus-server-to-method srv))) + (groupspec (mapconcat + (lambda (x) + (if (gnus-string-match-p "gmane" x) + (format "group:%s" (gnus-group-short-name x)) + (error "Can't search non-gmane groups: %s" x))) + groups " ")) + (authorspec + (if (assq 'author query) + (format "author:%s" (cdr (assq 'author query))) "")) + (search (format "%s %s %s" + qstring groupspec authorspec)) + (gnus-inhibit-demon t) + artlist) + (require 'mm-url) + (with-current-buffer (get-buffer-create nnir-tmp-buffer) + (erase-buffer) + (mm-url-insert + (concat + "http://search.gmane.org/nov.php" + "?" + (mm-url-encode-www-form-urlencoded + `(("query" . ,search) + ("HITSPERPAGE" . "999"))))) + (unless (featurep 'xemacs) (set-buffer-multibyte t)) + (mm-decode-coding-region (point-min) (point-max) 'utf-8) + (goto-char (point-min)) + (forward-line 1) + (while (not (eobp)) + (unless (or (eolp) (looking-at "\x0d")) + (let ((header (nnheader-parse-nov))) + (let ((xref (mail-header-xref header)) + (xscore (string-to-number (cdr (assoc 'X-Score + (mail-header-extra header)))))) + (when (string-match " \\([^:]+\\)[:/]\\([0-9]+\\)" xref) + (push + (vector + (gnus-group-prefixed-name (match-string 1 xref) srv) + (string-to-number (match-string 2 xref)) xscore) + artlist))))) + (forward-line 1))) + (apply 'vector (nreverse (mm-delete-duplicates artlist))))) ;;; Util Code: -(defun nnir-read-parms (query) +(defun nnir-read-parms (query nnir-search-engine) "Reads additional search parameters according to `nnir-engines'." (let ((parmspec (caddr (assoc nnir-search-engine nnir-engines)))) - (cons (cons 'query query) - (mapcar 'nnir-read-parm parmspec)))) + (append query + (mapcar 'nnir-read-parm parmspec)))) (defun nnir-read-parm (parmspec) "Reads a single search parameter. @@ -1565,107 +1464,64 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (let ((sym (car parmspec)) (prompt (cdr parmspec))) (if (listp prompt) - (let* ((result (apply 'completing-read prompt)) + (let* ((result (apply 'gnus-completing-read prompt)) (mapping (or (assoc result nnir-imap-search-arguments) - (assoc nil nnir-imap-search-arguments)))) + (cons nil nnir-imap-search-other)))) (cons sym (format (cdr mapping) result))) (cons sym (read-string prompt))))) -(defun nnir-run-query (query) +(autoload 'gnus-group-topic-name "gnus-topic") + +(defun nnir-run-query (query nserver) "Invoke appropriate search engine function (see `nnir-engines'). -If some groups were process-marked, run the query for each of the groups -and concat the results." - (let ((q (car (read-from-string query)))) - (if gnus-group-marked - (apply 'vconcat - (mapcar (lambda (x) - (let ((server (nnir-group-server x)) - search-func) - (setq search-func (cadr - (assoc - (nnir-read-server-parm 'nnir-search-engine server) nnir-engines))) - (if search-func - (funcall search-func q server x) - nil))) - gnus-group-marked) - ) - (apply 'vconcat - (mapcar (lambda (x) - (if (and (equal (cadr x) 'ok) (not (equal (cadar x) "-ephemeral"))) - (let ((server (format "%s:%s" (caar x) (cadar x))) - search-func) - (setq search-func (cadr - (assoc - (nnir-read-server-parm 'nnir-search-engine server) nnir-engines))) - (if search-func - (funcall search-func q server nil) - nil)) - nil)) - gnus-opened-servers) - )) - )) + If some groups were process-marked, run the query for each of the groups + and concat the results." + (let ((q (car (read-from-string query))) + (groups (if (string= "all-ephemeral" nserver) + (with-current-buffer gnus-server-buffer + (list (list (gnus-server-server-name)))) + (nnir-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)))) + (apply 'vconcat + (mapcar + (lambda (x) + (let* ((server (car x)) + (nnir-search-engine + (or (nnir-read-server-parm 'nnir-search-engine + server) + (cdr (assoc (car + (gnus-server-to-method server)) + nnir-method-default-engines)))) + search-func) + (setq search-func (cadr (assoc nnir-search-engine + nnir-engines))) + (if search-func + (funcall search-func + (if nnir-extra-parms + (nnir-read-parms q nnir-search-engine) + q) + server (cadr x)) + nil))) + groups)))) (defun nnir-read-server-parm (key server) - "Returns the parameter value of for the given server, where server is of -form 'backend:name'." + "Returns the parameter value of key for the given server, where +server is of form 'backend:name'." (let ((method (gnus-server-to-method server))) (cond ((and method (assq key (cddr method))) - (nth 1 (assq key (cddr method)))) - ((and nnir-mail-backend - (gnus-server-equal method nnir-mail-backend)) - (symbol-value key)) - (t nil)))) -;; (if method -;; (if (assq key (cddr method)) -;; (nth 1 (assq key (cddr method))) -;; (symbol-value key)) -;; (symbol-value key)) -;; )) - -(defun nnir-group-full-name (shortname server) - "For the given group name, return a full Gnus group name. -The Gnus backend/server information is added." - (gnus-group-prefixed-name shortname (gnus-server-to-method server))) + (nth 1 (assq key (cddr method)))) + (t nil)))) (defun nnir-possibly-change-server (server) (unless (and server (nnir-server-opened server)) (nnir-open-server server))) -;; Data type article list. - -(defun nnir-artlist-length (artlist) - "Returns number of articles in artlist." - (length artlist)) - -(defun nnir-artlist-article (artlist n) - "Returns from ARTLIST the Nth artitem (counting starting at 1)." - (elt artlist (1- n))) - -(defun nnir-artitem-group (artitem) - "Returns the group from the ARTITEM." - (elt artitem 0)) - -(defun nnir-artlist-artitem-group (artlist n) - "Returns from ARTLIST the group of the Nth artitem (counting from 1)." - (nnir-artitem-group (nnir-artlist-article artlist n))) - -(defun nnir-artitem-number (artitem) - "Returns the number from the ARTITEM." - (elt artitem 1)) - -(defun nnir-artlist-artitem-number (artlist n) - "Returns from ARTLIST the number of the Nth artitem (counting from 1)." - (nnir-artitem-number (nnir-artlist-article artlist n))) - -(defun nnir-artitem-rsv (artitem) - "Returns the Retrieval Status Value (RSV, score) from the ARTITEM." - (elt artitem 2)) - -(defun nnir-artlist-artitem-rsv (artlist n) - "Returns from ARTLIST the Retrieval Status Value of the Nth artitem -\(counting from 1)." - (nnir-artitem-rsv (nnir-artlist-article artlist n))) ;; unused? (defun nnir-artlist-groups (artlist) @@ -1679,9 +1535,73 @@ The Gnus backend/server information is added." with-dups) res)) +(defun nnir-get-active (srv) + (let ((method (gnus-server-to-method srv)) + groups) + (gnus-request-list method) + (with-current-buffer nntp-server-buffer + (let ((cur (current-buffer)) + name) + (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 (mm-string-as-unibyte + (gnus-group-full-name + (buffer-substring + (point) + (progn + (skip-chars-forward "^ \t") + (point))) method)) + groups)) + (forward-line)) + (while (not (eobp)) + (ignore-errors + (push (mm-string-as-unibyte + (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 nnir-registry-action (action data-header from &optional to method) + "Call `gnus-registry-action' with the original article group." + (gnus-registry-action + action + data-header + (nnir-article-group (mail-header-number data-header)) + to + method)) + +(defun nnir-mode () + (when (eq (car (gnus-find-method-for-group gnus-newsgroup-name)) 'nnir) + (setq gnus-summary-line-format + (or nnir-summary-line-format gnus-summary-line-format)) + (when (and (boundp 'gnus-registry-install) + (eq gnus-registry-install t)) + (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action t) + (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action t) + (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action t) + (add-hook 'gnus-summary-article-delete-hook 'nnir-registry-action t t) + (add-hook 'gnus-summary-article-move-hook 'nnir-registry-action t t) + (add-hook 'gnus-summary-article-expire-hook 'nnir-registry-action t t)))) + + ;; The end. (provide 'nnir) -;; arch-tag: 9b3fecf8-4397-4bbb-bf3c-6ac3cbbc6664 ;;; nnir.el ends here |