;;; 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, 2011 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:
;; 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"
(autoload 'nnimap-buffer "nnimap")
(autoload 'nnimap-command "nnimap")
(autoload 'nnimap-possibly-change-group "nnimap")
- (autoload 'gnus-registry-action "gnus-registry")
- (defvar gnus-registry-install))
-
+ (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-ignored-newsgroups ""
:type '(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 '(directory)
:group 'nnir)
+(defcustom nnir-notmuch-program "notmuch"
+ "*Name of notmuch search executable."
+ :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\"))"
+ :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."
+ :type '(regexp)
+ :group 'nnir)
+
;;; Developer Extension Variable:
(defvar nnir-engines
((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
;; 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)
(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))
(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)
'nov)))
(deffoo nnir-request-article (article &optional group server to-buffer)
- (if (stringp article)
+ (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 '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)
(deffoo nnir-warp-to-article ()
(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 "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,
"[/\\]" "." 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)
(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)))
(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-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)
;; 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.
;; (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))
(autoload 'gnus-group-topic-name "gnus-topic")
-(defun nnir-run-query (query nserver)
+(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))))
+ (groups (if (not (string= "nnir" nnir-address))
+ (list (list nnir-address))
(nnir-categorize
(or gnus-group-marked
(if (gnus-group-group-name)
(let* ((server (car x))
(nnir-search-engine
(or (nnir-read-server-parm 'nnir-search-engine
- server)
+ server t)
(cdr (assoc (car
(gnus-server-to-method server))
nnir-method-default-engines))))
(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))
+ (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)
- "Returns the parameter value of key for the given server, where
-server is of form 'backend:name'."
+(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-possibly-change-server (server)
(unless (and server (nnir-server-opened server))
(nnir-open-server server)))
+(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)
(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 (and (boundp 'gnus-registry-install)
- (eq gnus-registry-install 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)