;; 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-article RET) on an article. You
+;; will be warped into the group this article came from. Typing `A W'
+;; (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
;; 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
;; 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:
-
-;; * 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.
-;;
-
-;; Have you got other ideas?
+;; `nnir-search-engine' as a server variable.
;;; 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)
(eval-when-compile
(require 'cl))
+
+(eval-when-compile
+ (autoload 'nnimap-buffer "nnimap")
+ (autoload 'nnimap-command "nnimap")
+ (autoload 'nnimap-possibly-change-group "nnimap"))
+
(nnoo-declare nnir)
(nnoo-define-basics nnir)
(gnus-declare-backend "nnir" 'mail)
-(defvar nnir-imap-search-field "TEXT"
- "The IMAP search item when doing an nnir search. To use raw
- imap queries by default set this to \"\"")
-
-(defvar nnir-imap-search-arguments
- '(("Whole message" . "TEXT")
- ("Subject" . "SUBJECT")
- ("To" . "TO")
- ("From" . "FROM")
- ("Head" . "HEADER \"%s\"")
- (nil . ""))
- "Mapping from user readable strings to IMAP search items for use in nnir")
-
-(defvar nnir-imap-search-argument-history ()
- "The history for querying search options in nnir")
-
-(defvar nnir-get-article-nov-override-function nil
- "If non-nil, a function that will be passed each search result. This
-should return a message's headers in NOV format.
-
-If this variable is nil, or if the provided function returns nil for a search
-result, `gnus-retrieve-headers' will be called instead.")
-
-
-;;; Developer Extension Variable:
-
-(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.
-
-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'.
-
-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-method-default-engines
+ '((nnimap . imap)
+ (nntp . gmane))
+ "*Alist of default search engines keyed by server method"
+ :type '(alist)
:group 'nnir)
-;; Search engine to use.
-
-(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)
-
-;; freeWAIS-sf.
-
-(defcustom nnir-wais-program "waissearch"
- "*Name of waissearch executable."
+(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 '(string)
:group 'nnir)
-(defcustom nnir-wais-database (expand-file-name "~/.wais/mail")
- "*Name of Wais database containing the mail.
-
-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)
- :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)
- :group 'nnir)
-
(defcustom nnir-swish++-configuration-file
(expand-file-name "~/Mail/swish++.conf")
"*Configuration file for swish++."
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)
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)
: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."
"*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)
+;; Imap variables
+
+(defvar nnir-imap-search-arguments
+ '(("Whole message" . "TEXT")
+ ("Subject" . "SUBJECT")
+ ("To" . "TO")
+ ("From" . "FROM")
+ ("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:
+
+(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.
+
+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'.
+
+Add an entry here when adding a new search engine.")
+
+(defvar nnir-get-article-nov-override-function nil
+ "If non-nil, a function that will be passed each search result. This
+should return a message's headers in NOV format.
+
+If this variable is nil, or if the provided function returns nil for a search
+result, `gnus-retrieve-headers' will be called instead.")
+
;;; Internal Variables:
(defvar nnir-current-query nil
(defvar nnir-tmp-buffer " *nnir*"
"Internal: temporary buffer.")
+(defvar nnir-search-history ()
+ "Internal: the history for querying search options in nnir")
+
+(defvar nnir-extra-parms nil
+ "Internal: stores request for extra search parms")
+
;;; Code:
;; 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.
(equal server nnir-current-server)))
nnir-artlist
;; Cache miss.
- (setq nnir-artlist (nnir-run-query group)))
+ (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
(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))
+ (setq server (gnus-group-server artfullgroup))
;; retrieve NOV or HEAD data for this article, transform into
;; NOV data and prepend to `novdata'
(set-buffer nntp-server-buffer)
;; in nnir group
(when novitem
(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"
(gnus-request-article artno artfullgroup nntp-server-buffer)
(cons artfullgroup artno)))))
+(deffoo nnir-request-move-article (article group server accept-form
+ &optional last internal-move-group)
+ (let* ((artitem (nnir-artlist-article nnir-artlist
+ article))
+ (artfullgroup (nnir-artitem-group artitem))
+ (artno (nnir-artitem-number artitem))
+ (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))
+ (artsubject (mail-header-subject
+ (gnus-data-header
+ (assoc article (gnus-data-list nil))))))
+ (setq gnus-newsgroup-original-name artfullgroup)
+ (string-match "^\\[[0-9]+:.+/[0-9]+\\] " artsubject)
+ (setq gnus-article-original-subject (substring artsubject (match-end 0)))
+ (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-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-artlist-artitem-group nnir-artlist cur))
+ (backend-number (nnir-artlist-artitem-number nnir-artlist cur)))
+ (gnus-summary-read-group-1 gnus-newsgroup-name t t gnus-summary-buffer
+ nil (list backend-number))))
(nnoo-define-skeleton nnir)
;;; 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")
-
-(eval-when-compile
- (autoload 'nnimap-buffer "nnimap")
- (autoload 'nnimap-command "nnimap")
- (autoload 'nnimap-possibly-change-group "nnimap"))
-
-(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))
- (gnus-inhibit-demon t)
- artlist)
+ (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)))
+ artlist)
(message "Opening server %s" server)
- (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)
- (push (vector group artnum 1) artlist)
- (setq arts (1+ arts)))
- (and (car result)
- (delete 0 (mapcar #'string-to-number
- (cdr (assoc "SEARCH" (cdr result)))))))
- (message "Searching %s... %d matches" group arts)))
- (message "Searching %s...done" group))
- (quit nil))
- (reverse artlist))))
+ (apply
+ 'vconcat
+ (mapcar
+ (lambda (x)
+ (let ((group x))
+ (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) (push (vector group artnum 1) artlist)
+ (setq arts (1+ arts)))
+ (and (car result)
+ (delete 0 (mapcar #'string-to-number
+ (cdr (assoc "SEARCH"
+ (cdr result)))))))
+ (message "Searching %s... %d matches" group arts)))
+ (message "Searching %s...done" group))
+ (quit nil))
+ (reverse artlist)))
+ groups)))))
(defun nnir-imap-make-query (criteria qstring)
"Parse the query string and criteria into an appropriate IMAP search
(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
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)))
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)))
(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
;; 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
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= (gnus-group-server server) "nnmaildir")
":[0-9]+"
(> (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
(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
- (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 (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 (nnir-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."
+ (if (gnus-string-match-p "gmane" srv)
+ (let* ((case-fold-search t)
+ (qstring (cdr (assq 'query query)))
+ (server (cadr (gnus-server-to-method srv)))
+ (groupspec (if groups
+ (mapconcat
+ (function (lambda (x)
+ (format "group:%s"
+ (gnus-group-short-name 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 nntp-server-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)))
+ ;; Sort by score
+ (apply 'vector
+ (sort artlist
+ (function (lambda (x y)
+ (> (nnir-artitem-rsv x)
+ (nnir-artitem-rsv y)))))))
+ (message "Can't search non-gmane nntp groups")
+ nil))
;;; 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.
(let ((sym (car parmspec))
(prompt (cdr parmspec)))
(if (listp prompt)
- (let* ((result (gnus-completing-read prompt nil))
+ (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-sort-groups-by-server
+ (or gnus-group-marked
+ (if (gnus-group-group-name)
+ (list (gnus-group-group-name))
+ (cdr (assoc (gnus-group-topic-name)
+ gnus-topic-alist))))))))
+ (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 (cdr 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))
-;; ))
+ (nth 1 (assq key (cddr method))))
+ (t nil))))
(defun nnir-group-full-name (shortname server)
"For the given group name, return a full Gnus group name.
(elt artitem 2))
(defun nnir-artlist-artitem-rsv (artlist n)
- "Returns from ARTLIST the Retrieval Status Value of the Nth artitem
-\(counting from 1)."
+ "Returns from ARTLIST the Retrieval Status Value of the Nth
+artitem (counting from 1)."
(nnir-artitem-rsv (nnir-artlist-article artlist n)))
;; unused?
with-dups)
res))
+(defun nnir-sort-groups-by-server (groups)
+ "sorts a list of groups into an alist keyed by server"
+(if (car groups)
+ (let (value)
+ (dolist (var groups value)
+ (let ((server (gnus-group-server var)))
+ (if (assoc server value)
+ (nconc (cdr (assoc server value)) (list var))
+ (push (cons server (list var)) value))))
+ value)
+ nil))
+
+(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 (string= gnus-ignored-newsgroups "")
+ (delete-matching-lines gnus-ignored-newsgroups))
+ (while (not (eobp))
+ (ignore-errors
+ (push (mm-string-as-unibyte
+ (let ((p (point)))
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (buffer-substring (+ p 1) (- (point) 1)))
+ (gnus-group-full-name name method)))
+ groups))
+ (forward-line))))
+ groups))
;; The end.
(provide 'nnir)
projects / gnus / blobdiff