;;; 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, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Kai Großjohann <grossjohann@ls6.cs.uni-dortmund.de>
;; Swish-e and Swish++ backends 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.
+;; can type `A W' (aka M-x gnus-warp-to-article RET) on an article. You
+;; will be warped into the group this article came from. Typing `A T'
+;; (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
;; `nnir-engines'. Then, users can choose the backend by setting
;; `nnir-search-engine' as a server variable.
-;;; Setup Code:
+;;; Code:
+
+;;; Setup:
;; For Emacs <22.2 and XEmacs.
(eval-and-compile
(require 'nnoo)
(require 'gnus-group)
-(require 'gnus-sum)
(require 'message)
(require 'gnus-util)
(eval-when-compile
(require 'cl))
+;;; 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-current-group-marked nil
+ "Internal: stores current list of process-marked groups.")
+
+(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")
+
+;; Imap variables
+
+(defvar nnir-imap-search-arguments
+ '(("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"
+ "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")
+
+;;; Helper macros
+
+;; Data type article list.
+
+(defmacro nnir-artlist-length (artlist)
+ "Returns number of articles in artlist."
+ `(length ,artlist))
+
+(defmacro nnir-artlist-article (artlist n)
+ "Returns from ARTLIST the Nth artitem (counting starting at 1)."
+ `(when (> ,n 0)
+ (elt ,artlist (1- ,n))))
+
+(defmacro nnir-artitem-group (artitem)
+ "Returns the group from the ARTITEM."
+ `(elt ,artitem 0))
+
+(defmacro nnir-artitem-number (artitem)
+ "Returns the number from the ARTITEM."
+ `(elt ,artitem 1))
+
+(defmacro nnir-artitem-rsv (artitem)
+ "Returns the Retrieval Status Value (RSV, score) from the ARTITEM."
+ `(elt ,artitem 2))
+
+(defmacro nnir-article-group (article)
+ "Returns the group for ARTICLE"
+ `(nnir-artitem-group (nnir-artlist-article nnir-artlist ,article)))
+
+(defmacro nnir-article-number (article)
+ "Returns the number for ARTICLE"
+ `(nnir-artitem-number (nnir-artlist-article nnir-artlist ,article)))
+
+(defmacro nnir-article-rsv (article)
+ "Returns the rsv for ARTICLE"
+ `(nnir-artitem-rsv (nnir-artlist-article nnir-artlist ,article)))
+
+(defsubst nnir-article-ids (article)
+ "Returns the pair `(nnir id . real id)' of ARTICLE"
+ (cons article (nnir-article-number article)))
+
+(defmacro nnir-categorize (sequence keyfunc &optional valuefunc)
+ "Sorts a sequence into categories and returns a list of the form
+`((key1 (element11 element12)) (key2 (element21 element22))'.
+The category key for a member of the sequence is obtained
+as `(keyfunc member)' and the corresponding element is just
+`member'. If `valuefunc' is non-nil, the element of the list
+is `(valuefunc member)'."
+ `(unless (null ,sequence)
+ (let (value)
+ (mapc
+ (lambda (member)
+ (let ((y (,keyfunc member))
+ (x ,(if valuefunc
+ `(,valuefunc member)
+ 'member)))
+ (if (assoc y value)
+ (push x (cadr (assoc y value)))
+ (push (list y (list x)) value))))
+ ,sequence)
+ value)))
+
+;;; Finish setup:
+
+(require 'gnus-sum)
(eval-when-compile
(autoload 'nnimap-buffer "nnimap")
(autoload 'nnimap-command "nnimap")
- (autoload 'nnimap-possibly-change-group "nnimap"))
+ (autoload 'nnimap-possibly-change-group "nnimap")
+ (autoload 'nnimap-make-thread-query "nnimap")
+ (autoload 'gnus-registry-action "gnus-registry"))
(nnoo-declare nnir)
(nnoo-define-basics nnir)
+(defvoo nnir-address nil
+ "The address of the nnir server.")
+
(gnus-declare-backend "nnir" 'mail)
;;; 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)
+(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)
-(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-summary-line-format nil
+ "*The format specification of the lines in an nnir summary buffer.
-(defcustom nnir-wais-program "waissearch"
- "*Name of waissearch executable."
+All the items from `gnus-summary-line-format' are available, along
+with three items unique to nnir summary buffers:
+
+%Z Search retrieval score value (integer)
+%G Article original full group name (string)
+%g Article original short group name (string)
+
+If nil this will use `gnus-summary-line-format'."
+ :version "24.1"
:type '(string)
:group 'nnir)
-(defcustom nnir-wais-database (expand-file-name "~/.wais/mail")
- "*Name of Wais database containing the mail.
+(defcustom nnir-retrieve-headers-override-function nil
+ "*If non-nil, a function that accepts an article list and group
+and populates the `nntp-server-buffer' with the retrieved
+headers. Must return either 'nov or 'headers indicating the
+retrieved header format.
-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)
+If this variable is nil, or if the provided function returns nil for a search
+result, `gnus-retrieve-headers' will be called instead."
+ :version "24.1"
+ :type '(function)
: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)
+(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\"."
+ :version "24.1"
+ :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem)))
+ nnir-imap-search-arguments))
:group 'nnir)
(defcustom nnir-swish++-configuration-file
:type '(directory)
:group 'nnir)
-;; Imap variables
+(defcustom nnir-notmuch-program "notmuch"
+ "*Name of notmuch search executable."
+ :version "24.1"
+ :type '(string)
+ :group 'nnir)
-(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")
+(defcustom nnir-notmuch-additional-switches '()
+ "*A list of strings, to be given as additional arguments to notmuch.
-(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")
+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)
-(defvar nnir-imap-search-argument-history ()
- "The history for querying search options in 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
- `((wais nnir-run-waissearch
- ())
- (imap nnir-run-imap
+ `((imap nnir-run-imap
((criteria
"Imap Search in" ; Prompt
,(mapcar 'car nnir-imap-search-arguments) ; alist for completing
((group . "Swish-e Group spec: ")))
(namazu nnir-run-namazu
())
+ (notmuch nnir-run-notmuch
+ ())
(hyrex nnir-run-hyrex
((group . "Hyrex Group spec: ")))
(find-grep nnir-run-find-grep
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
- "Internal: stores current query (= group name).")
-
-(defvar nnir-current-server nil
- "Internal: stores current server (does it ever change?).")
-
-(defvar nnir-current-group-marked nil
- "Internal: stores current list of process-marked groups.")
-
-(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")
-
-;;; Code:
+(defcustom nnir-method-default-engines
+ '((nnimap . imap)
+ (nntp . gmane))
+ "*Alist of default search engines keyed by server method."
+ :version "24.1"
+ :type `(repeat (cons (choice (const nnimap) (const nttp) (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))))
+ :group 'nnir)
;; Gnus glue.
-(defun gnus-group-make-nnir-group (nnir-extra-parms)
+(defun gnus-group-make-nnir-group (nnir-extra-parms &optional parms)
"Create an nnir group. Asks for query."
(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* ((query (unless parms (read-string "Query: " nil 'nnir-search-history)))
+ (parms (or parms (list (cons 'query query))))
+ (srv (or (cdr (assq 'server parms)) (gnus-server-server-name) "nnir")))
+ (add-to-list 'parms (cons 'unique-id (message-unique-id)) t)
(gnus-group-read-ephemeral-group
(concat "nnir:" (prin1-to-string parms)) (list 'nnir srv) t
(cons (current-buffer) gnus-current-window-configuration)
nil)))
-;; 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))
- (id (mail-header-id (gnus-summary-article-header)))
- (refs (split-string
- (mail-header-references (gnus-summary-article-header)))))
- (if (eq (car (gnus-find-method-for-group group)) 'nnimap)
- (progn
- (nnimap-possibly-change-group (gnus-group-short-name group) nil)
- (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"
- '(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.
(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)
(equal server nnir-current-server)))
nnir-artlist
;; Cache miss.
- (setq nnir-artlist (nnir-run-query group server)))
+ (setq nnir-artlist (nnir-run-query group)))
(with-current-buffer nntp-server-buffer
(setq nnir-current-query group)
(when server (setq nnir-current-server server))
group)))) ; group name
(deffoo nnir-retrieve-headers (articles &optional group server fetch-old)
- (save-excursion
- (let ((artlist (copy-sequence articles))
- art artitem artgroup artno artrsv artfullgroup
- novitem novdata foo server)
- (while (not (null artlist))
- (setq art (car artlist))
- (or (numberp art)
- (nnheader-report
- 'nnir
- "nnir-retrieve-headers doesn't grok message ids: %s"
- art))
- (setq artitem (nnir-artlist-article nnir-artlist art))
- (setq artrsv (nnir-artitem-rsv artitem))
- (setq artfullgroup (nnir-artitem-group artitem))
- (setq artno (nnir-artitem-number artitem))
- (setq artgroup (gnus-group-real-name 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)
- (nnir-possibly-change-server server)
- (let ((gnus-override-method
- (gnus-server-to-method server)))
- ;; 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
- (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)
+ (with-current-buffer nntp-server-buffer
+ (let ((gnus-inhibit-demon t)
+ (articles-by-group (nnir-categorize
+ articles nnir-article-group nnir-article-ids))
+ headers)
+ (while (not (null articles-by-group))
+ (let* ((group-articles (pop articles-by-group))
+ (artgroup (car group-articles))
+ (articleids (cadr group-articles))
+ (artlist (sort (mapcar 'cdr articleids) '<))
+ (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?
+ (erase-buffer)
+ (case (setq gnus-headers-retrieved-by
+ (or
+ (and
+ nnir-retrieve-headers-override-function
+ (funcall nnir-retrieve-headers-override-function
+ artlist artgroup))
+ (gnus-retrieve-headers artlist artgroup nil)))
+ (nov
+ (setq parsefunc 'nnheader-parse-nov))
+ (headers
+ (setq parsefunc 'nnheader-parse-head))
+ (t (error "Unknown header type %s while requesting articles \
+ of group %s" gnus-headers-retrieved-by artgroup)))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let* ((novitem (funcall parsefunc))
+ (artno (and novitem
+ (mail-header-number novitem)))
+ (art (car (rassq artno articleids))))
+ (when art
+ (mail-header-set-number novitem art)
+ (push novitem headers))
+ (forward-line 1)))))
+ (setq headers
+ (sort headers
+ (lambda (x y)
+ (< (mail-header-number x) (mail-header-number y)))))
+ (erase-buffer)
+ (mapc 'nnheader-insert-nov headers)
'nov)))
-(deffoo nnir-request-article (article
- &optional group server to-buffer)
- (if (stringp article)
+(deffoo nnir-request-article (article &optional group server to-buffer)
+ (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* ((artitem (nnir-artlist-article nnir-artlist
- article))
- (artfullgroup (nnir-artitem-group artitem))
- (artno (nnir-artitem-number artitem))
- ;; Bug?
- ;; Why must we bind nntp-server-buffer here? It won't
- ;; work if `buf' is used, say. (Of course, the set-buffer
- ;; line below must then be updated, too.)
- (nntp-server-buffer (or to-buffer nntp-server-buffer)))
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (message "Requesting article %d from group %s"
- artno artfullgroup)
- (gnus-request-article artno artfullgroup nntp-server-buffer)
- (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 'unique-id article)
+ (cons 'criteria "")
+ (cons 'shortcut t)))
+ (unless (and (equal query nnir-current-query)
+ (equal server nnir-current-server))
+ (setq nnir-artlist (nnir-run-imap query server))
+ (setq nnir-current-query query)
+ (setq nnir-current-server server))
+ (setq article 1))
+ (unless (zerop (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)
+ (let* ((artfullgroup (nnir-article-group article))
+ (artno (nnir-article-number article))
+ (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)))
+ (unless (gnus-check-backend-function
+ 'request-move-article artfullgroup)
+ (error "The group %s does not support article moving" artfullgroup))
+ (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-request-expire-articles (articles group &optional server force)
+ (if force
+ (let ((articles-by-group (nnir-categorize
+ articles nnir-article-group nnir-article-ids))
+ not-deleted)
+ (while (not (null articles-by-group))
+ (let* ((group-articles (pop articles-by-group))
+ (artgroup (car group-articles))
+ (articleids (cadr group-articles))
+ (artlist (sort (mapcar 'cdr articleids) '<)))
+ (unless (gnus-check-backend-function 'request-expire-articles
+ artgroup)
+ (error "The group %s does not support article deletion" artgroup))
+ (unless (gnus-check-server (gnus-find-method-for-group artgroup))
+ (error "Couldn't open server for group %s" artgroup))
+ (push (gnus-request-expire-articles
+ artlist artgroup force)
+ not-deleted)))
+ (sort (delq nil not-deleted) '<))
+ articles))
+
+(deffoo nnir-warp-to-article ()
+ (let* ((cur (if (> (gnus-summary-article-number) 0)
+ (gnus-summary-article-number)
+ (error "This is not a real article")))
+ (backend-article-group (nnir-article-group cur))
+ (backend-article-number (nnir-article-number cur))
+ (quit-config (gnus-ephemeral-group-p gnus-newsgroup-name)))
+ ;; 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 (eq (cdr quit-config) 'summary)
+ (gnus-summary-exit))
+ (gnus-summary-read-group-1 backend-article-group t t nil
+ nil (list backend-article-number))))
(nnoo-define-skeleton nnir)
;; 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,
(gnus-replace-in-string dirnam "^[./\\]" "" t)
"[/\\]" "." t)))
- (vector (nnir-group-full-name group server)
- (if (string= (gnus-group-server server) "nnmaildir")
+ (vector (gnus-group-full-name group server)
+ (if (string-match "^nnmaildir:" (gnus-group-server server))
(nnmaildir-base-name-to-article-number
(substring article 0 (string-match ":" article))
group nil)
;;; 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
(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)))
(cdr (assoc nnir-imap-default-search-key
nnir-imap-search-arguments))))
(gnus-inhibit-demon t)
- (groups (or groups (nnir-get-active srv)))
- artlist)
+ (groups (or groups (nnir-get-active srv))))
(message "Opening server %s" server)
(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)))))
+ (catch 'found
+ (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)
+ (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
;; 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)
;; Windows "\\" -> "."
(setq group (gnus-replace-in-string group "\\\\" "."))
- (push (vector (nnir-group-full-name group server)
+ (push (vector (gnus-group-full-name group server)
(string-to-number artno)
(string-to-number score))
artlist))))
;; 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.
score (match-string 3))
(when (string-match prefix dirnam)
(setq dirnam (replace-match "" t t dirnam)))
- (push (vector (nnir-group-full-name
+ (push (vector (gnus-group-full-name
(gnus-replace-in-string dirnam "/" ".") server)
(string-to-number artno)
(string-to-number score))
;; (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
(> (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 '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))
(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)
(unless directory
(error "No directory found in method specification of server %s"
(nreverse res))
".")))
(push
- (vector (nnir-group-full-name group server) art 0)
+ (vector (gnus-group-full-name group server) art 0)
artlist))
(forward-line 1)))
(message "Searching %s using find-grep...done"
;; gmane interface
(defun nnir-run-gmane (query srv &optional groups)
"Run a search against a gmane back-end server."
- (if (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 " ") ""))
+ (groupspec (mapconcat
+ (lambda (x)
+ (if (gnus-string-match-p "gmane" x)
+ (format "group:%s" (gnus-group-short-name x))
+ (error "Can't search non-gmane groups: %s" 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
+ (with-current-buffer (get-buffer-create nnir-tmp-buffer)
(erase-buffer)
(mm-url-insert
(concat
(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")))
+ (apply 'vector (nreverse (mm-delete-duplicates artlist)))))
;;; Util Code:
(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))))
- (nconc query
+ (append query
(mapcar 'nnir-read-parm parmspec))))
(defun nnir-read-parm (parmspec)
(cons sym (format (cdr mapping) result)))
(cons sym (read-string prompt)))))
-(defun nnir-run-query (query nserver)
+(autoload 'gnus-group-topic-name "gnus-topic")
+
+(defun nnir-run-query (query)
"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-sort-groups-by-server
- (or gnus-group-marked (list (gnus-group-group-name)))))))
+ (groups (if (not (string= "nnir" nnir-address))
+ (list (list nnir-address))
+ (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 (cdr 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'."
+ (mapcar
+ (lambda (x)
+ (let* ((server (car x))
+ (nnir-search-engine
+ (or (nnir-read-server-parm 'nnir-search-engine
+ server t)
+ (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
+ (or (and (eq nnir-search-engine 'imap)
+ (assq 'criteria q) q)
+ (setq q (nnir-read-parms q nnir-search-engine)))
+ q)
+ server (cadr x))
+ nil)))
+ groups))))
+
+(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))))
+ (nth 1 (assq key (cddr method))))
+ ((and (not not-global) (boundp key)) (symbol-value key))
+ (t nil))))
-(defun nnir-group-full-name (shortname server)
- "For the given group name, return a full Gnus group name.
-The Gnus backend/server information is added."
- (gnus-group-prefixed-name shortname (gnus-server-to-method server)))
(defun nnir-possibly-change-server (server)
(unless (and server (nnir-server-opened server))
(nnir-open-server server)))
-;; Data type article list.
-
-(defun nnir-artlist-length (artlist)
- "Returns number of articles in artlist."
- (length artlist))
-
-(defun nnir-artlist-article (artlist n)
- "Returns from ARTLIST the Nth artitem (counting starting at 1)."
- (elt artlist (1- n)))
-
-(defun nnir-artitem-group (artitem)
- "Returns the group from the ARTITEM."
- (elt artitem 0))
-
-(defun nnir-artlist-artitem-group (artlist n)
- "Returns from ARTLIST the group of the Nth artitem (counting from 1)."
- (nnir-artitem-group (nnir-artlist-article artlist n)))
-
-(defun nnir-artitem-number (artitem)
- "Returns the number from the ARTITEM."
- (elt artitem 1))
-
-(defun nnir-artlist-artitem-number (artlist n)
- "Returns from ARTLIST the number of the Nth artitem (counting from 1)."
- (nnir-artitem-number (nnir-artlist-article artlist n)))
-
-(defun nnir-artitem-rsv (artitem)
- "Returns the Retrieval Status Value (RSV, score) from the ARTITEM."
- (elt artitem 2))
-
-(defun nnir-artlist-artitem-rsv (artlist n)
- "Returns from ARTLIST the Retrieval Status Value of the Nth
-artitem (counting from 1)."
- (nnir-artitem-rsv (nnir-artlist-article artlist n)))
+(defun nnir-search-thread (header)
+ "Make an nnir group based on the thread containing the article header"
+ (let ((parm (list
+ (cons 'query
+ (nnimap-make-thread-query header))
+ (cons 'criteria "")
+ (cons 'server (gnus-method-to-server
+ (gnus-find-method-for-group
+ gnus-newsgroup-name))))))
+ (gnus-group-make-nnir-group nil parm)
+ (gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header)))))
;; unused?
(defun nnir-artlist-groups (artlist)
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 (gnus-group-server var) (list var)) value))))
- value)
- nil))
-
(defun nnir-get-active (srv)
(let ((method (gnus-server-to-method srv))
groups)
(let ((cur (current-buffer))
name)
(goto-char (point-min))
- (unless (string= gnus-ignored-newsgroups "")
- (delete-matching-lines gnus-ignored-newsgroups))
- ;; We treat NNTP as a special case to avoid problems with
- ;; garbage group names like `"foo' that appear in some badly
- ;; managed active files. -jh.
+ (unless (or (null nnir-ignored-newsgroups)
+ (string= nnir-ignored-newsgroups ""))
+ (delete-matching-lines nnir-ignored-newsgroups))
(if (eq (car method) 'nntp)
(while (not (eobp))
(ignore-errors
- (push (cons
- (mm-string-as-unibyte
+ (push (mm-string-as-unibyte
+ (gnus-group-full-name
(buffer-substring
(point)
(progn
(skip-chars-forward "^ \t")
- (point))))
- (let ((last (read cur)))
- (cons (read cur) last)))
+ (point))) method))
groups))
(forward-line))
(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)))
+ (if (eq (char-after) ?\")
+ (gnus-group-full-name (read cur) method)
+ (let ((p (point)) (name ""))
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (buffer-substring p (point)))
+ (while (eq (char-after) ?\\)
+ (setq p (1+ (point)))
+ (forward-char 2)
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (concat name (buffer-substring
+ p (point)))))
+ (gnus-group-full-name name method))))
groups))
(forward-line)))))
groups))
+(defun nnir-registry-action (action data-header from &optional to method)
+ "Call `gnus-registry-action' with the original article group."
+ (gnus-registry-action
+ action
+ data-header
+ (nnir-article-group (mail-header-number data-header))
+ to
+ method))
+
+(defun nnir-mode ()
+ (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))
+ (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))))
+
+
+
;; The end.
(provide 'nnir)
projects / gnus / blobdiff