;;; nnir.el --- search mail with various search engines -*- coding: iso-8859-1 -*-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Kai Großjohann <grossjohann@ls6.cs.uni-dortmund.de>
;; Swish-e and Swish++ backends by:
;; IMAP search improved by Daniel Pittman <daniel@rimspace.net>.
;; nnmaildir support for Swish++ and Namazu backends by:
;; Justus Piater <Justus <at> Piater.name>
+;; Keywords: news mail searching ir
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
-;; FIXME: This file should be move to ../lisp/ after all copyright assignments
-;; are on file. As of 2008-04-13, we don't have an assignment/disclaimer from
-;; Torsten Hilbrich, but he's willing to sign. I've sent him the form.
-;; -- rsteib
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
;; TODO: Documentation in the Gnus manual
;; `gnus-group-make-nnir-group' might be described in (info
;; "(gnus)Foreign Groups") as well.
-;; Keywords: news mail searching ir
-
-;; This file is part of GNU Emacs.
-
-;; This is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
;; The most recent version of this can always be fetched from the Gnus
-;; CVS repository. See http://www.gnus.org/ for more information.
+;; 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
;; 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
(require 'gnus-sum)
(require 'message)
(require 'gnus-util)
-(eval-and-compile
+(eval-when-compile
(require 'cl))
(nnoo-declare 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
+ ((criteria
"Search in: " ; Prompt
,nnir-imap-search-arguments ; alist for completing
nil ; no filtering
;; `nnir-swish-e-additional-switches'
(make-obsolete-variable 'nnir-swish-e-index-file
- 'nnir-swish-e-index-files)
+ 'nnir-swish-e-index-files "Emacs 23.1")
(defcustom nnir-swish-e-index-file
(expand-file-name "~/Mail/index.swish-e")
"*Index file for swish-e.
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))
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."))
+ (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))
;; Just set the server variables appropriately.
(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.
nnir-artlist
;; Cache miss.
(setq nnir-artlist (nnir-run-query group)))
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(if (zerop (length nnir-artlist))
(progn
(setq nnir-current-query nil
(nnir-possibly-change-server server)
(let ((gnus-override-method
(gnus-server-to-method server)))
- (case (setq foo (gnus-retrieve-headers (list artno) artfullgroup 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)))
- (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))))
+ ;; if nnir-get-article-nov-override-function is set, use it
+ (if nnir-get-article-nov-override-function
+ (setq novitem (funcall nnir-get-article-nov-override-function
+ artitem))
+ ;; else, set novitem through nnheader-parse-nov/nnheader-parse-head
+ (case (setq foo (gnus-retrieve-headers (list artno)
+ artfullgroup 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)))
+ (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)
(defmacro nnir-add-result (dirnam artno score prefix server artlist)
- "Ask `nnir-compose-result' to construct a result vector,
+ "Ask `nnir-compose-result' to construct a result vector,
and if it is non-nil, add it to artlist."
`(let ((result (nnir-compose-result ,dirnam ,artno ,score ,prefix ,server)))
(when (not (null result))
"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."))
+ (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))
(unless (string-match prefix dirnam)
(nnheader-report 'nnir "Dir name %s doesn't contain prefix %s"
dirnam prefix))
- (setq group (substitute ?. ?/ (replace-match "" t t dirnam)))
+ (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)))))))))
+ (sort artlist
+ (function (lambda (x y)
+ (> (nnir-artitem-rsv x)
+ (nnir-artitem-rsv y)))))))))
;; IMAP interface.
;; todo:
to an arbitrary query string to the end user.
The search is always case-insensitive, as defined by RFC2060, and supports
-the following features (inspired by the Google search input language):
+the following features (inspired by the Google search input language):
Automatic \"and\" queries
If you specify multiple words then they will be treated as an \"and\"
"Are we at the end of input?"
(skip-chars-forward "[[:blank:]]")
(looking-at "$"))
-
+
;; Swish++ interface.
;; -cc- Todo
Windows NT 4.0."
(when group
- (error "The swish++ backend cannot search specific groups."))
+ (error "The swish++ backend cannot search specific groups"))
(save-excursion
(let ( (qstring (cdr (assq 'query query)))
score artno dirnam filenam)
(when (equal "" qstring)
- (error "swish++: You didn't enter anything."))
+ (error "swish++: You didn't enter anything"))
(set-buffer (get-buffer-create nnir-tmp-buffer))
(erase-buffer)
;; Sort by score
(apply 'vector
- (sort* artlist
- (function (lambda (x y)
- (> (nnir-artitem-rsv x)
- (nnir-artitem-rsv y)))))))))
+ (sort artlist
+ (function (lambda (x y)
+ (> (nnir-artitem-rsv x)
+ (nnir-artitem-rsv y)))))))))
;; Swish-E interface.
(defun nnir-run-swish-e (query server &optional group)
;; swish-e crashes with empty parameter to "-w" on commandline...
(when group
- (error "The swish-e backend cannot search specific groups."))
+ (error "The swish-e backend cannot search specific groups"))
(save-excursion
(let ((qstring (cdr (assq 'query query)))
artlist score artno dirnam group )
(when (equal "" qstring)
- (error "swish-e: You didn't enter anything."))
+ (error "swish-e: You didn't enter anything"))
(set-buffer (get-buffer-create nnir-tmp-buffer))
(erase-buffer)
;; eliminate all ".", "/", "\" from beginning. Always matches.
(string-match "^[./\\]*\\(.*\\)$" dirnam)
;; "/" -> "."
- (setq group (substitute ?. ?/ (match-string 1 dirnam)))
+ (setq group (gnus-replace-in-string (match-string 1 dirnam) "/" "."))
;; Windows "\\" -> "."
- (setq group (substitute ?. ?\\ group))
+ (setq group (gnus-replace-in-string group "\\\\" "."))
(push (vector (nnir-group-full-name group server)
(string-to-number artno)
;; Sort by score
(apply 'vector
- (sort* artlist
- (function (lambda (x y)
- (> (nnir-artitem-rsv x)
- (nnir-artitem-rsv y)))))))))
+ (sort artlist
+ (function (lambda (x y)
+ (> (nnir-artitem-rsv x)
+ (nnir-artitem-rsv y)))))))))
;; HyREX interface
(defun nnir-run-hyrex (query server &optional group)
score (match-string 3))
(when (string-match prefix dirnam)
(setq dirnam (replace-match "" t t dirnam)))
- (push (vector (nnir-group-full-name (substitute ?. ?/ dirnam) server)
+ (push (vector (nnir-group-full-name
+ (gnus-replace-in-string dirnam "/" ".") server)
(string-to-number artno)
(string-to-number score))
artlist))
(message "Massaging hyrex-search output...done.")
(apply 'vector
- (sort* artlist
- (function (lambda (x y)
- (if (string-lessp (nnir-artitem-group x)
- (nnir-artitem-group y))
- t
- (< (nnir-artitem-number x)
- (nnir-artitem-number y)))))))
+ (sort artlist
+ (function (lambda (x y)
+ (if (string-lessp (nnir-artitem-group x)
+ (nnir-artitem-group y))
+ t
+ (< (nnir-artitem-number x)
+ (nnir-artitem-number y)))))))
)))
;; Namazu interface
;; sort artlist by score
(apply 'vector
- (sort* artlist
- (function (lambda (x y)
- (> (nnir-artitem-rsv x)
- (nnir-artitem-rsv y)))))))))
+ (sort artlist
+ (function (lambda (x y)
+ (> (nnir-artitem-rsv x)
+ (nnir-artitem-rsv y)))))))))
(defun nnir-run-find-grep (query server &optional group)
"Run find and grep to obtain matching articles."
"."
;; 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.
- (find-if 'file-directory-p
- (let ((group (gnus-group-real-name group)))
- (list group (gnus-replace-in-string group "\\." "/" t)))))))
+ ;; 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
'call-process "find" nil t
"find" group "-type" "f" "-name" "[0-9]*" "-exec"
"grep"
- `("-l" ,@(and grep-options (split-string grep-options "\\s-" t))
+ `("-l" ,@(and grep-options
+ (split-string grep-options "\\s-" t))
"-e" ,regexp "{}" "+"))))
;; Translate relative paths to group names.
(art (string-to-number (car (last path)))))
(while (string= "." (car path))
(setq path (cdr path)))
- (let ((group (mapconcat 'identity (subseq path 0 -1) ".")))
+ (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)))
;; The end.
(provide 'nnir)
-;;; arch-tag: 9b3fecf8-4397-4bbb-bf3c-6ac3cbbc6664
+;;; nnir.el ends here