;;; 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.
+;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Kai Großjohann <grossjohann@ls6.cs.uni-dortmund.de>
;; Swish-e and Swish++ backends by:
;; 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))
+
+(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")
+(defvar 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\"")
(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")
+(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
())
(imap nnir-run-imap
((criteria
- "Search in: " ; Prompt
- ,nnir-imap-search-arguments ; alist for completing
- nil ; no filtering
+ "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-search-field ; default
+ ,nnir-imap-default-search-key ; default
)))
(swish++ nnir-run-swish++
((group . "Group spec: ")))
: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'
(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.
: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."
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))
- 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)))
+ (id (mail-header-id (gnus-summary-article-header)))
+ (refs (split-string
+ (mail-header-references (gnus-summary-article-header)))))
+ (if (string= (car (gnus-group-method group)) "nnimap")
+ (with-current-buffer (nnimap-buffer)
+ (let* ((cmd (let ((value
+ (format
+ "(OR HEADER REFERENCES %s HEADER Message-Id %s)"
+ id id)))
+ (dolist (refid refs value)
+ (setq value (format
+ "(OR (OR HEADER Message-Id %s HEADER REFERENCES %s) %s)"
+ refid refid value)))))
+ (result (nnimap-command
+ "UID SEARCH %s" cmd)))
+ (gnus-summary-read-group-1 group t t gnus-summary-buffer nil
+ (and (car result)
+ (delete 0 (mapcar #'string-to-number
+ (cdr (assoc "SEARCH" (cdr result)))))))))
+ (gnus-summary-read-group-1 group t t gnus-summary-buffer
+ nil (list backend-number))
+ (gnus-summary-limit (list backend-number))
+ (gnus-summary-refer-thread))))
+
(if (fboundp 'eval-after-load)
(eval-after-load "gnus-sum"
;; 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)))
+ (headers
+ (goto-char (point-min))
+ (setq novitem (nnheader-parse-head)))
+ (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)))
+ (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"
+ artrsv artgroup artno
+ (mail-header-subject novitem)))
+ (push novitem novdata)
+ (setq artlist (cdr artlist))))
(setq novdata (nreverse novdata))
(set-buffer nntp-server-buffer) (erase-buffer)
(mapc 'nnheader-insert-nov novdata)
(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
"[/\\]" "." t)))
(vector (nnir-group-full-name group server)
- (if (string= server "nnmaildir:")
+ (if (string= (gnus-group-server server) "nnmaildir")
(nnmaildir-base-name-to-article-number
(substring article 0 (string-match ":" article))
group nil)
"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:
-;; 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)
"Run a search against an IMAP back-end server.
(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)
+ (cdr (assoc nnir-imap-default-search-key
+ nnir-imap-search-arguments))))
+ (gnus-inhibit-demon t)
+ artlist)
(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))
+ (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))))
(defun nnir-imap-make-query (criteria qstring)
(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
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)))
;; 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)
(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
(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
;; 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)))
(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)))))
;; The end.
(provide 'nnir)
-;; arch-tag: 9b3fecf8-4397-4bbb-bf3c-6ac3cbbc6664
;;; nnir.el ends here
projects / gnus / blobdiff