X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnir.el;h=a826b5be7915ddb20fec3e7c7afb197531d5ff20;hb=74a489ff1213794152d6e13f7a11e16c89f62602;hp=0658b1e2050ceb74d8b3cc2376f26510b95ac8f7;hpb=e2c9efb05a1ae9e65fd40bab80466da331f3981b;p=gnus diff --git a/lisp/nnir.el b/lisp/nnir.el index 0658b1e20..a826b5be7 100644 --- a/lisp/nnir.el +++ b/lisp/nnir.el @@ -1,7 +1,7 @@ ;;; 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, 2009 Free Software Foundation, Inc. +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Kai Großjohann ;; Swish-e and Swish++ backends by: @@ -52,7 +52,7 @@ ;; 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 @@ -263,10 +263,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 @@ -336,7 +336,7 @@ (require 'gnus-sum) (require 'message) (require 'gnus-util) -(eval-and-compile +(eval-when-compile (require 'cl)) (nnoo-declare nnir) @@ -358,6 +358,14 @@ (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 @@ -505,7 +513,7 @@ that it is for swish++, not Wais." ;; `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. @@ -690,7 +698,7 @@ The returned format is as `gnus-server-to-method' needs it. See 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)) @@ -725,7 +733,7 @@ and show thread that contains this article." ;; 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. @@ -736,8 +744,7 @@ and show thread that contains this article." 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 @@ -779,25 +786,31 @@ and show thread that contains this article." (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) @@ -889,7 +902,7 @@ ready to be added to the list of search results." "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)) @@ -916,17 +929,18 @@ pairs (also vectors, actually)." (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: @@ -1161,7 +1175,7 @@ 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.")) + (error "The swish++ backend cannot search specific groups")) (save-excursion (let ( (qstring (cdr (assq 'query query))) @@ -1178,7 +1192,7 @@ Windows NT 4.0." 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) @@ -1235,10 +1249,10 @@ Windows NT 4.0." ;; 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) @@ -1250,7 +1264,7 @@ 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.")) + (error "The swish-e backend cannot search specific groups")) (save-excursion (let ((qstring (cdr (assq 'query query))) @@ -1260,7 +1274,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." 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) @@ -1316,9 +1330,9 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." ;; 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) @@ -1329,10 +1343,10 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." ;; 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) @@ -1397,19 +1411,20 @@ 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 (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 @@ -1476,10 +1491,10 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." ;; 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." @@ -1505,11 +1520,14 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." "." ;; 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 @@ -1532,7 +1550,14 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (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))) @@ -1671,5 +1696,4 @@ The Gnus backend/server information is added." ;; The end. (provide 'nnir) -;; arch-tag: 9b3fecf8-4397-4bbb-bf3c-6ac3cbbc6664 ;;; nnir.el ends here