X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnnir.el;h=4dd123bf2c75f4040cfcfac643ec87888b92a288;hp=6c97f7279fc651561652c4ede3d32526b639c828;hb=9ff43b22e07294fa5393fdea5c1e90a86edbe717;hpb=9ebaf43d5423c1a6a291c06b2c16fb22a0bf32e6 diff --git a/lisp/nnir.el b/lisp/nnir.el index 6c97f7279..4dd123bf2 100644 --- a/lisp/nnir.el +++ b/lisp/nnir.el @@ -1,9 +1,8 @@ -;;; nnir.el --- search mail with various search engines -*- coding: iso-8859-1 -*- +;;; nnir.el --- search mail with various search engines -*- coding: utf-8 -*- -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, -;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1998-2013 Free Software Foundation, Inc. -;; Author: Kai Großjohann +;; Author: Kai Großjohann ;; Swish-e and Swish++ backends by: ;; Christoph Conrad . ;; IMAP backend by: Simon Josefsson . @@ -30,10 +29,6 @@ ;;; Commentary: -;; TODO: Documentation in the Gnus manual - -;; Where in the existing gnus manual would this fit best? - ;; 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 @@ -137,17 +132,26 @@ ;; other backend. ;; The interface between the two layers consists of the single -;; function `nnir-run-query', which just selects the appropriate -;; function for the search engine one is using. The input to -;; `nnir-run-query' is a string, representing the query as input by -;; the user. The output of `nnir-run-query' is supposed to be a -;; vector, each element of which should in turn be a three-element -;; vector. The first element should be full group name of the article, -;; the second element should be the article number, and the third -;; element should be the Retrieval Status Value (RSV) as returned from -;; the search engine. An RSV is the score assigned to the document by -;; the search engine. For Boolean search engines, the -;; RSV is always 1000 (or 1 or 100, or whatever you like). +;; function `nnir-run-query', which dispatches the search to the +;; proper search function. The argument of `nnir-run-query' is an +;; alist with two keys: 'nnir-query-spec and 'nnir-group-spec. The +;; value for 'nnir-query-spec is an alist. The only required key/value +;; pair is (query . "query") specifying the search string to pass to +;; the query engine. Individual engines may have other elements. The +;; value of 'nnir-group-spec is a list with the specification of the +;; groups/servers to search. The format of the 'nnir-group-spec is +;; (("server1" ("group11" "group12")) ("server2" ("group21" +;; "group22"))). If any of the group lists is absent then all groups +;; on that server are searched. + +;; The output of `nnir-run-query' is supposed to be a vector, each +;; element of which should in turn be a three-element vector. The +;; first element should be full group name of the article, the second +;; element should be the article number, and the third element should +;; be the Retrieval Status Value (RSV) as returned from the search +;; engine. An RSV is the score assigned to the document by the search +;; engine. For Boolean search engines, the RSV is always 1000 (or 1 +;; or 100, or whatever you like). ;; The sorting order of the articles in the summary buffer created by ;; nnir is based on the order of the articles in the above mentioned @@ -180,35 +184,31 @@ ;;; 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?).") +(defvar nnir-memo-query nil + "Internal: stores current query.") -(defvar nnir-current-group-marked nil - "Internal: stores current list of process-marked groups.") +(defvar nnir-memo-server nil + "Internal: stores current server.") (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-extra-parms nil - "Internal: stores request for extra search parms") +(defconst nnir-tmp-buffer " *nnir*" + "Internal: temporary buffer.") + ;; Imap variables (defvar nnir-imap-search-arguments - '(("Whole message" . "TEXT") - ("Subject" . "SUBJECT") - ("To" . "TO") - ("From" . "FROM") - ("Imap" . "")) + '(("whole message" . "TEXT") + ("subject" . "SUBJECT") + ("to" . "TO") + ("from" . "FROM") + ("body" . "BODY") + ("imap" . "")) "Mapping from user readable keys to IMAP search items for use in nnir") (defvar nnir-imap-search-other "HEADER %S" @@ -288,31 +288,29 @@ is `(valuefunc member)'." (eval-when-compile (autoload 'nnimap-buffer "nnimap") (autoload 'nnimap-command "nnimap") - (autoload 'nnimap-possibly-change-group "nnimap") - (autoload 'gnus-registry-action "gnus-registry")) + (autoload 'nnimap-change-group "nnimap") + (autoload 'nnimap-make-thread-query "nnimap") + (autoload 'gnus-registry-action "gnus-registry") + (autoload 'gnus-registry-get-id-key "gnus-registry") + (autoload 'gnus-group-topic-name "gnus-topic")) + (nnoo-declare nnir) (nnoo-define-basics nnir) -(gnus-declare-backend "nnir" 'mail) +(gnus-declare-backend "nnir" 'mail 'virtual) ;;; User Customizable Variables: (defgroup nnir nil - "Search groups in Gnus with assorted seach engines." + "Search groups in Gnus with assorted search engines." :group 'gnus) -(defcustom nnir-method-default-engines - '((nnimap . imap) - (nntp . gmane)) - "*Alist of default search engines keyed by server method." - :type '(alist) - :group 'nnir) - (defcustom nnir-ignored-newsgroups "" "*A regexp to match newsgroups in the active file that should be skipped when searching." + :version "24.1" :type '(regexp) :group 'nnir) @@ -327,7 +325,8 @@ with three items unique to nnir summary buffers: %g Article original short group name (string) If nil this will use `gnus-summary-line-format'." - :type '(regexp) + :version "24.1" + :type '(choice (const :tag "gnus-summary-line-format" nil) string) :group 'nnir) (defcustom nnir-retrieve-headers-override-function nil @@ -338,14 +337,17 @@ retrieved header format. 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) + :version "24.1" + :type '(choice (const :tag "gnus-retrieve-headers" nil) function) :group 'nnir) -(defcustom nnir-imap-default-search-key "Whole message" +(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) + by default set this to \"imap\"." + :version "24.1" + :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) + nnir-imap-search-arguments)) :group 'nnir) (defcustom nnir-swish++-configuration-file @@ -503,6 +505,34 @@ arrive at the correct group name, \"mail.misc\"." :type '(directory) :group 'nnir) +(defcustom nnir-notmuch-program "notmuch" + "*Name of notmuch search executable." + :version "24.1" + :type '(string) + :group 'nnir) + +(defcustom nnir-notmuch-additional-switches '() + "*A list of strings, to be given as additional arguments to notmuch. + +Note that this should be a list. Ie, do NOT use the following: + (setq nnir-notmuch-additional-switches \"-i -w\") ; wrong +Instead, use this: + (setq nnir-notmuch-additional-switches '(\"-i\" \"-w\"))" + :version "24.1" + :type '(repeat (string)) + :group 'nnir) + +(defcustom nnir-notmuch-remove-prefix (concat (getenv "HOME") "/Mail/") + "*The prefix to remove from each file name returned by notmuch +in order to get a group name (albeit with / instead of .). This is a +regular expression. + +This variable is very similar to `nnir-namazu-remove-prefix', except +that it is for notmuch, not Namazu." + :version "24.1" + :type '(regexp) + :group 'nnir) + ;;; Developer Extension Variable: (defvar nnir-engines @@ -516,15 +546,17 @@ arrive at the correct group name, \"mail.misc\"." ,nnir-imap-default-search-key ; default ))) (gmane nnir-run-gmane - ((author . "Gmane Author: "))) + ((gmane-author . "Gmane Author: "))) (swish++ nnir-run-swish++ - ((group . "Swish++ Group spec: "))) + ((swish++-group . "Swish++ Group spec (regexp): "))) (swish-e nnir-run-swish-e - ((group . "Swish-e Group spec: "))) + ((swish-e-group . "Swish-e Group spec (regexp): "))) (namazu nnir-run-namazu ()) + (notmuch nnir-run-notmuch + ()) (hyrex nnir-run-hyrex - ((group . "Hyrex Group spec: "))) + ((hyrex-group . "Hyrex Group spec (regexp): "))) (find-grep nnir-run-find-grep ((grep-options . "Grep options: ")))) "Alist of supported search engines. @@ -544,57 +576,111 @@ needs the variables `nnir-namazu-program', Add an entry here when adding a new search engine.") +(defcustom nnir-method-default-engines '((nnimap . imap) (nntp . gmane)) + "*Alist of default search engines keyed by server method." + :version "24.1" + :group 'nnir + :type `(repeat (cons (choice (const nnimap) (const nntp) (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))))) ;; Gnus glue. -(defun gnus-group-make-nnir-group (nnir-extra-parms) - "Create an nnir group. Asks for query." +(defun gnus-group-make-nnir-group (nnir-extra-parms &optional specs) + "Create an nnir group. Prompt for a search query and determine +the groups to search as follows: if called from the *Server* +buffer search all groups belonging to the server on the current +line; if called from the *Group* buffer search any marked groups, +or the group on the current line, or all the groups under the +current topic. Calling with a prefix-arg prompts for additional +search-engine specific constraints. A non-nil `specs' arg must be +an alist with `nnir-query-spec' and `nnir-group-spec' keys, and +skips all prompting." (interactive "P") - (setq nnir-current-query nil - nnir-current-server nil - nnir-current-group-marked nil - nnir-artlist nil) - (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) + (let* ((group-spec + (or (cdr (assq 'nnir-group-spec specs)) + (if (gnus-server-server-name) + (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)))) + (query-spec + (or (cdr (assq 'nnir-query-spec specs)) + (apply + 'append + (list (cons 'query + (read-string "Query: " nil 'nnir-search-history))) + (when nnir-extra-parms + (mapcar + (lambda (x) + (nnir-read-parms (nnir-server-to-search-engine (car x)))) + group-spec)))))) (gnus-group-read-ephemeral-group - (concat "nnir:" (prin1-to-string parms)) (list 'nnir srv) t - (cons (current-buffer) gnus-current-window-configuration) - nil))) + (concat "nnir-" (message-unique-id)) + (list 'nnir "nnir") + nil +; (cons (current-buffer) gnus-current-window-configuration) + nil + nil nil + (list + (cons 'nnir-specs (list (cons 'nnir-query-spec query-spec) + (cons 'nnir-group-spec group-spec))) + (cons 'nnir-artlist nil))))) + +(defun gnus-summary-make-nnir-group (nnir-extra-parms) + "Search a group from the summary buffer." + (interactive "P") + (gnus-warp-to-article) + (let ((spec + (list + (cons 'nnir-group-spec + (list (list + (gnus-group-server gnus-newsgroup-name) + (list gnus-newsgroup-name))))))) + (gnus-group-make-nnir-group nnir-extra-parms spec))) ;; 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 info) - "GROUP is the query string." - (nnir-possibly-change-server server) - ;; Check for cache and return that if appropriate. - (if (and (equal group nnir-current-query) - (equal gnus-group-marked nnir-current-group-marked) - (or (null server) - (equal server nnir-current-server))) - nnir-artlist - ;; Cache miss. - (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)) - (nnheader-report 'nnir "Search produced empty results.") - ;; Remember data for cache. - (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 + (let ((backend (car (gnus-server-to-method server)))) + (if backend + (nnoo-change-server backend server definitions) + (add-hook 'gnus-summary-mode-hook 'nnir-mode) + (nnoo-change-server 'nnir server definitions)))) + +(deffoo nnir-request-group (group &optional server dont-check info) + (nnir-possibly-change-group group server) + (let ((pgroup (gnus-group-guess-full-name-from-command-method group)) + length) + ;; Check for cached search result or run the query and cache the + ;; result. + (unless (and nnir-artlist dont-check) + (gnus-group-set-parameter + pgroup 'nnir-artlist + (setq nnir-artlist + (nnir-run-query + (gnus-group-get-parameter pgroup 'nnir-specs t)))) + (nnir-request-update-info pgroup (gnus-get-info pgroup))) + (with-current-buffer nntp-server-buffer + (if (zerop (setq length (nnir-artlist-length nnir-artlist))) + (progn + (nnir-close-group group) + (nnheader-report 'nnir "Search produced empty results.")) + (nnheader-insert "211 %d %d %d %s\n" + length ; total # + 1 ; first # + length ; last # + group)))) ; group name + nnir-artlist) (deffoo nnir-retrieve-headers (articles &optional group server fetch-old) (with-current-buffer nntp-server-buffer @@ -610,13 +696,7 @@ Add an entry here when adding a new search engine.") (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? + ;; (nnir-possibly-change-group nil server) (erase-buffer) (case (setq gnus-headers-retrieved-by (or @@ -634,7 +714,8 @@ Add an entry here when adding a new search engine.") (goto-char (point-min)) (while (not (eobp)) (let* ((novitem (funcall parsefunc)) - (artno (mail-header-number novitem)) + (artno (and novitem + (mail-header-number novitem))) (art (car (rassq artno articleids)))) (when art (mail-header-set-number novitem art) @@ -649,25 +730,44 @@ Add an entry here when adding a new search engine.") 'nov))) (deffoo nnir-request-article (article &optional group server to-buffer) - (if (stringp article) + (nnir-possibly-change-group group server) + (if (and (stringp article) + (not (eq 'nnimap (car (gnus-server-to-method server))))) (nnheader-report 'nnir - "nnir-retrieve-headers doesn't grok message ids: %s" - article) + "nnir-request-article only groks message ids for nnimap servers: %s" + server) (save-excursion - (let ((artfullgroup (nnir-article-group article)) - (artno (nnir-article-number article))) - (message "Requesting article %d from group %s" - artno artfullgroup) - (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))))) + (let ((article article) + query) + (when (stringp article) + (setq gnus-override-method (gnus-server-to-method server)) + (setq query + (list + (cons 'query (format "HEADER Message-ID %s" article)) + (cons 'criteria "") + (cons 'shortcut t))) + (unless (and nnir-artlist (equal query nnir-memo-query) + (equal server nnir-memo-server)) + (setq nnir-artlist (nnir-run-imap query server) + nnir-memo-query query + nnir-memo-server server)) + (setq article 1)) + (unless (zerop (nnir-artlist-length nnir-artlist)) + (let ((artfullgroup (nnir-article-group article)) + (artno (nnir-article-number article))) + (message "Requesting article %d from group %s" + artno artfullgroup) + (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) + (nnir-possibly-change-group group server) (let* ((artfullgroup (nnir-article-group article)) (artno (nnir-article-number article)) (to-newsgroup (nth 1 accept-form)) @@ -688,6 +788,7 @@ Add an entry here when adding a new search engine.") (gnus-group-real-name to-newsgroup))))) (deffoo nnir-request-expire-articles (articles group &optional server force) + (nnir-possibly-change-group group server) (if force (let ((articles-by-group (nnir-categorize articles nnir-article-group nnir-article-ids)) @@ -709,15 +810,103 @@ Add an entry here when adding a new search engine.") articles)) (deffoo nnir-warp-to-article () + (nnir-possibly-change-group gnus-newsgroup-name) (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)))) + (error "Can't warp to a pseudo-article"))) + (backend-article-group (nnir-article-group cur)) + (backend-article-number (nnir-article-number cur)) + (quit-config (gnus-ephemeral-group-p gnus-newsgroup-name))) + + ;; what should we do here? we could leave all the buffers around + ;; and assume that we have to exit from them one by one. or we can + ;; try to clean up directly + + ;;first exit from the nnir summary buffer. +; (gnus-summary-exit) + ;; and if the nnir summary buffer in turn came from another + ;; summary buffer we have to clean that summary up too. + ; (when (not (eq (cdr quit-config) 'group)) +; (gnus-summary-exit)) + (gnus-summary-read-group-1 backend-article-group t t nil + nil (list backend-article-number)))) + +(deffoo nnir-request-update-mark (group article mark) + (let ((artgroup (nnir-article-group article)) + (artnumber (nnir-article-number article))) + (gnus-request-update-mark artgroup artnumber mark))) + +(deffoo nnir-request-set-mark (group actions &optional server) + (nnir-possibly-change-group group server) + (let (mlist) + (dolist (action actions) + (destructuring-bind (range action marks) action + (let ((articles-by-group (nnir-categorize + (gnus-uncompress-range range) + nnir-article-group nnir-article-number))) + (dolist (artgroup articles-by-group) + (push (list + (car artgroup) + (list (gnus-compress-sequence + (sort (cadr artgroup) '<)) action marks)) mlist))))) + (dolist (request (nnir-categorize mlist car cadr)) + (gnus-request-set-mark (car request) (cadr request))))) + + +(deffoo nnir-request-update-info (group info &optional server) + (nnir-possibly-change-group group server) + ;; clear out all existing marks. + (gnus-info-set-marks info nil) + (gnus-info-set-read info nil) + (let ((group (gnus-group-guess-full-name-from-command-method group)) + (articles-by-group + (nnir-categorize + (gnus-uncompress-range (cons 1 (nnir-artlist-length nnir-artlist))) + nnir-article-group nnir-article-ids))) + (gnus-set-active group + (cons 1 (nnir-artlist-length nnir-artlist))) + (while (not (null articles-by-group)) + (let* ((group-articles (pop articles-by-group)) + (articleids (reverse (cadr group-articles))) + (group-info (gnus-get-info (car group-articles))) + (marks (gnus-info-marks group-info)) + (read (gnus-info-read group-info))) + (gnus-info-set-read + info + (gnus-add-to-range + (gnus-info-read info) + (delq nil + (mapcar + #'(lambda (art) + (when (gnus-member-of-range (cdr art) read) (car art))) + articleids)))) + (dolist (mark marks) + (destructuring-bind (type . range) mark + (gnus-add-marked-articles + group type + (delq nil + (mapcar + #'(lambda (art) + (when (gnus-member-of-range (cdr art) range) (car art))) + articleids))))))))) + + +(deffoo nnir-close-group (group &optional server) + (nnir-possibly-change-group group server) + (let ((pgroup (gnus-group-guess-full-name-from-command-method group))) + (when (and nnir-artlist (not (gnus-ephemeral-group-p pgroup))) + (gnus-group-set-parameter pgroup 'nnir-artlist nnir-artlist)) + (setq nnir-artlist nil) + (when (gnus-ephemeral-group-p pgroup) + (gnus-kill-ephemeral-group pgroup) + (setq gnus-ephemeral-servers + (delq (assq 'nnir gnus-ephemeral-servers) + gnus-ephemeral-servers))))) +;; (gnus-opened-servers-remove +;; (car (assoc '(nnir "nnir-ephemeral" (nnir-address "nnir")) +;; gnus-opened-servers)))) + -(nnoo-define-skeleton nnir) (defmacro nnir-add-result (dirnam artno score prefix server artlist) @@ -743,7 +932,7 @@ ready to be added to the list of search results." ;; remove trailing slash and, for nnmaildir, cur/new/tmp (setq dirnam (substring dirnam 0 - (if (string= (gnus-group-server server) "nnmaildir") + (if (string-match "\\`nnmaildir:" (gnus-group-server server)) -5 -1))) ;; Set group to dirnam without any leading dots or slashes, @@ -753,7 +942,7 @@ ready to be added to the list of search results." "[/\\]" "." t))) (vector (gnus-group-full-name group server) - (if (string= (gnus-group-server server) "nnmaildir") + (if (string-match "\\`nnmaildir:" (gnus-group-server server)) (nnmaildir-base-name-to-article-number (substring article 0 (string-match ":" article)) group nil) @@ -766,7 +955,7 @@ ready to be added to the list of search results." (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" +details on the language and supported extensions." (save-excursion (let ((qstring (cdr (assq 'query query))) (server (cadr (gnus-server-to-method srv))) @@ -779,33 +968,37 @@ details on the language and supported extensions" (message "Opening server %s" server) (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))))) + (catch 'found + (mapcar + #'(lambda (group) + (let (artlist) + (condition-case () + (when (nnimap-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) + (when (assq 'shortcut query) + (throw 'found (list 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 @@ -1000,14 +1193,15 @@ Windows NT 4.0." (save-excursion (let ( (qstring (cdr (assq 'query query))) - (groupspec (cdr (assq 'group query))) + (groupspec (cdr (assq 'swish++-group query))) (prefix (nnir-read-server-parm 'nnir-swish++-remove-prefix server)) artlist ;; nnml-use-compressed-files might be any string, but probably this ;; 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= (gnus-group-server server) "nnmaildir") + (article-pattern (if (string-match "\\`nnmaildir:" + (gnus-group-server server)) ":[0-9]+" "^[0-9]+\\(\\.[a-z0-9]+\\)?$")) score artno dirnam filenam) @@ -1173,7 +1367,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." (defun nnir-run-hyrex (query server &optional group) (save-excursion (let ((artlist nil) - (groupspec (cdr (assq 'group query))) + (groupspec (cdr (assq 'hyrex-group query))) (qstring (cdr (assq 'query query))) (prefix (nnir-read-server-parm 'nnir-hyrex-remove-prefix server)) score artno dirnam) @@ -1204,12 +1398,12 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." ;; nnir-search failure reason is in this buffer, show it if ;; the user wants it. (when (> gnus-verbose 6) - (display-buffer nnir-tmp-buffer)))) ;; FIXME: Dont clear buffer ! + (display-buffer nnir-tmp-buffer)))) ;; FIXME: Don't clear buffer ! (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" + ;; for nnml/nnfolder: "filename mailid weight" + ;; for nnimap: "group mailid weight" (goto-char (point-min)) (delete-non-matching-lines "^\\S + [0-9]+ [0-9]+$") ;; HyREX doesn't search directly in groups -- so filter out here. @@ -1249,7 +1443,8 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." ;; (when group ;; (error "The Namazu backend cannot search specific groups")) (save-excursion - (let ((article-pattern (if (string= (gnus-group-server server) "nnmaildir") + (let ((article-pattern (if (string-match "\\`nnmaildir:" + (gnus-group-server server)) ":[0-9]+" "^[0-9]+$")) artlist @@ -1309,6 +1504,81 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (> (nnir-artitem-rsv x) (nnir-artitem-rsv y))))))))) +(defun nnir-run-notmuch (query server &optional group) + "Run QUERY against notmuch. +Returns a vector of (group name, file name) pairs (also vectors, +actually)." + + ;; (when group + ;; (error "The notmuch backend cannot search specific groups")) + + (save-excursion + (let ( (qstring (cdr (assq 'query query))) + (groupspec (cdr (assq 'notmuch-group query))) + (prefix (nnir-read-server-parm 'nnir-notmuch-remove-prefix server)) + artlist + (article-pattern (if (string-match "\\`nnmaildir:" + (gnus-group-server server)) + ":[0-9]+" + "^[0-9]+$")) + artno dirnam filenam) + + (when (equal "" qstring) + (error "notmuch: You didn't enter anything")) + + (set-buffer (get-buffer-create nnir-tmp-buffer)) + (erase-buffer) + + (if groupspec + (message "Doing notmuch query %s on %s..." qstring groupspec) + (message "Doing notmuch query %s..." qstring)) + + (let* ((cp-list `( ,nnir-notmuch-program + nil ; input from /dev/null + t ; output + nil ; don't redisplay + "search" + "--format=text" + "--output=files" + ,@(nnir-read-server-parm 'nnir-notmuch-additional-switches server) + ,qstring ; the query, in notmuch format + )) + (exitstatus + (progn + (message "%s args: %s" nnir-notmuch-program + (mapconcat 'identity (cddddr cp-list) " ")) ;; ??? + (apply 'call-process cp-list)))) + (unless (or (null exitstatus) + (zerop exitstatus)) + (nnheader-report 'nnir "Couldn't run notmuch: %s" exitstatus) + ;; notmuch failure reason is in this buffer, show it if + ;; the user wants it. + (when (> gnus-verbose 6) + (display-buffer nnir-tmp-buffer)))) + + ;; The results are output in the format of: + ;; absolute-path-name + (goto-char (point-min)) + (while (not (eobp)) + (setq filenam (buffer-substring-no-properties (line-beginning-position) + (line-end-position)) + artno (file-name-nondirectory filenam) + dirnam (file-name-directory filenam)) + (forward-line 1) + + ;; don't match directories + (when (string-match article-pattern artno) + (when (not (null dirnam)) + + ;; maybe limit results to matching groups. + (when (or (not groupspec) + (string-match groupspec dirnam)) + (nnir-add-result dirnam artno "" prefix server artlist))))) + + (message "Massaging notmuch output...done") + + artlist))) + (defun nnir-run-find-grep (query server &optional grouplist) "Run find and grep to obtain matching articles." (let* ((method (gnus-server-to-method server)) @@ -1317,24 +1587,23 @@ 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) + (grouplist (or grouplist (nnir-get-active server)))) (unless directory (error "No directory found in method specification of server %s" server)) (apply 'vconcat (mapcar (lambda (x) - (let ((group x)) + (let ((group x) + artlist) (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. + ; postprocessing. (let ((group (if (not group) "." @@ -1357,7 +1626,8 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (save-excursion (apply 'call-process "find" nil t - "find" group "-type" "f" "-name" "[0-9]*" "-exec" + "find" group "-maxdepth" "1" "-type" "f" + "-name" "[0-9]*" "-exec" "grep" `("-l" ,@(and grep-options (split-string grep-options "\\s-" t)) @@ -1407,8 +1677,8 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (error "Can't search non-gmane groups: %s" x))) groups " ")) (authorspec - (if (assq 'author query) - (format "author:%s" (cdr (assq 'author query))) "")) + (if (assq 'gmane-author query) + (format "author:%s" (cdr (assq 'gmane-author query))) "")) (search (format "%s %s %s" qstring groupspec authorspec)) (gnus-inhibit-demon t) @@ -1444,11 +1714,16 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." ;;; Util Code: -(defun nnir-read-parms (query nnir-search-engine) +(defun gnus-nnir-group-p (group) + "Say whether GROUP is nnir or not." + (if (gnus-group-prefixed-p group) + (eq 'nnir (car (gnus-find-method-for-group group))) + (and group (string-match "^nnir" group)))) + +(defun nnir-read-parms (nnir-search-engine) "Reads additional search parameters according to `nnir-engines'." (let ((parmspec (caddr (assoc nnir-search-engine nnir-engines)))) - (append query - (mapcar 'nnir-read-parm parmspec)))) + (mapcar 'nnir-read-parm parmspec))) (defun nnir-read-parm (parmspec) "Reads a single search parameter. @@ -1462,70 +1737,70 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (cons sym (format (cdr mapping) result))) (cons sym (read-string prompt))))) -(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))) - (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 key for the given server, where -server is of form 'backend:name'." +(defun nnir-run-query (specs) + "Invoke appropriate search engine function (see `nnir-engines')." + (apply 'vconcat + (mapcar + (lambda (x) + (let* ((server (car x)) + (search-engine (nnir-server-to-search-engine server)) + (search-func (cadr (assoc search-engine nnir-engines)))) + (and search-func + (funcall search-func (cdr (assq 'nnir-query-spec specs)) + server (cadr x))))) + (cdr (assq 'nnir-group-spec specs))))) + +(defun nnir-server-to-search-engine (server) + (or (nnir-read-server-parm 'nnir-search-engine server t) + (cdr (assoc (car (gnus-server-to-method server)) + nnir-method-default-engines)))) + +(defun nnir-read-server-parm (key server &optional not-global) + "Returns the parameter value corresponding to `key' for +`server'. If no server-specific value is found consult the global +environment unless `not-global' is non-nil." (let ((method (gnus-server-to-method server))) (cond ((and method (assq key (cddr method))) - (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))) - - - -;; unused? -(defun nnir-artlist-groups (artlist) - "Returns a list of all groups in the given ARTLIST." - (let ((res nil) - (with-dups nil)) - ;; from each artitem, extract group component - (setq with-dups (mapcar 'nnir-artitem-group artlist)) - ;; remove duplicates from above - (mapc (function (lambda (x) (add-to-list 'res x))) - with-dups) - res)) + (nth 1 (assq key (cddr method)))) + ((and (not not-global) (boundp key)) (symbol-value key)) + (t nil)))) + +(defun nnir-possibly-change-group (group &optional server) + (or (not server) (nnir-server-opened server) (nnir-open-server server)) + (when (gnus-nnir-group-p group) + (setq nnir-artlist (gnus-group-get-parameter + (gnus-group-prefixed-name + (gnus-group-short-name group) '(nnir "nnir")) + 'nnir-artlist t)))) + +(defun nnir-server-opened (&optional server) + (let ((backend (car (gnus-server-to-method server)))) + (nnoo-current-server-p (or backend 'nnir) server))) + +(defun nnir-search-thread (header) + "Make an nnir group based on the thread containing the article +header. The current server will be searched. If the registry is +installed, the server that the registry reports the current +article came from is also searched." + (let* ((query + (list (cons 'query (nnimap-make-thread-query header)) + (cons 'criteria ""))) + (server + (list (list (gnus-method-to-server + (gnus-find-method-for-group gnus-newsgroup-name))))) + (registry-group (and + (gnus-bound-and-true-p 'gnus-registry-enabled) + (car (gnus-registry-get-id-key + (mail-header-id header) 'group)))) + (registry-server + (and registry-group + (gnus-method-to-server + (gnus-find-method-for-group registry-group))))) + (when registry-server (add-to-list 'server (list registry-server))) + (gnus-group-make-nnir-group nil (list + (cons 'nnir-query-spec query) + (cons 'nnir-group-spec server))) + (gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header))))) (defun nnir-get-active (srv) (let ((method (gnus-server-to-method srv)) @@ -1535,7 +1810,8 @@ server is of form 'backend:name'." (let ((cur (current-buffer)) name) (goto-char (point-min)) - (unless (string= nnir-ignored-newsgroups "") + (unless (or (null nnir-ignored-newsgroups) + (string= nnir-ignored-newsgroups "")) (delete-matching-lines nnir-ignored-newsgroups)) (if (eq (car method) 'nntp) (while (not (eobp)) @@ -1581,14 +1857,62 @@ server is of form 'backend:name'." (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)) - (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))) - + (when (gnus-bound-and-true-p 'gnus-registry-enabled) + (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)))) + + +(defun gnus-summary-create-nnir-group () + (interactive) + (or (nnir-server-opened "") (nnir-open-server "nnir")) + (let ((name (gnus-read-group "Group name: ")) + (method '(nnir "")) + (pgroup + (gnus-group-guess-full-name-from-command-method gnus-newsgroup-name))) + (with-current-buffer gnus-group-buffer + (gnus-group-make-group + name method nil + (gnus-group-find-parameter pgroup))))) + + +(deffoo nnir-request-create-group (group &optional server args) + (message "Creating nnir group %s" group) + (let* ((group (gnus-group-prefixed-name group '(nnir "nnir"))) + (specs (assq 'nnir-specs args)) + (query-spec + (or (cdr (assq 'nnir-query-spec specs)) + (list (cons 'query + (read-string "Query: " nil 'nnir-search-history))))) + (group-spec + (or (cdr (assq 'nnir-group-spec specs)) + (list (list (read-string "Server: " nil nil))))) + (nnir-specs (list (cons 'nnir-query-spec query-spec) + (cons 'nnir-group-spec group-spec)))) + (gnus-group-set-parameter group 'nnir-specs nnir-specs) + (gnus-group-set-parameter + group 'nnir-artlist + (or (cdr (assq 'nnir-artlist args)) + (nnir-run-query nnir-specs))) + (nnir-request-update-info group (gnus-get-info group))) + t) + +(deffoo nnir-request-delete-group (group &optional force server) + t) + +(deffoo nnir-request-list (&optional server) + t) + +(deffoo nnir-request-scan (group method) + t) + +(deffoo nnir-request-close () + t) +(nnoo-define-skeleton nnir) ;; The end. (provide 'nnir)