;;; nnmairix.el --- Mairix back end for Gnus, the Emacs newsreader
-;; Copyright (C) 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: David Engster <dengste@eml.cc>
;; Keywords: mail searching
;;; Commentary:
-;; THIS IS BETA SOFTWARE! This back end should not mess up or
-;; even delete your mails, but having a backup is always a good idea.
-
;; This is a back end for using the mairix search engine with
;; Gnus. Mairix is a tool for searching words in locally stored
;; mail. Mairix is very fast which allows using it efficiently for
;;
;; Mairix is written by Richard Curnow. More information can be found at
;; http://www.rpcurnow.force9.co.uk/mairix/
-;;
-;; For details about setting up mairix&Gnus&nnmairix.el, look at the
-;; emacswiki:
-;;
-;; http://www.emacswiki.org/cgi-bin/wiki/GnusMairix
-;;
-;; The newest version of nnmairix.el can be found at
-;;
-;; http://www.emacswiki.org/cgi-bin/emacs/nnmairix.el
-
-;; For impatient people, here's the setup in a nutshell:
-;;
-;; This back end requires an installed mairix binary which is
-;; configured to index your mail folder. You don't have to specify a
-;; search folder (but it does no harm, either). Visit the man page of
-;; mairix and mairixrc for details.
-;;
-;; Put nnmairix.el into your search path and "(require 'nnmarix)" into
-;; your .gnus. Then call nnmairix-create-default-group (or 'G b
-;; c'). This function will ask for all necessary information to create
-;; a mairix server in Gnus with the default search folder. This
-;; default search folder will be used for all temporary searches: call
-;; nnmairix-search ('G b s') and enter a mairix query (like
-;; f:test@example.com). To create a mairix group for one specific
-;; search query, use 'G b g'. See the emacswiki or the source for more
-;; information.
;; Commentary on the code: nnmairix sits between Gnus and the "real"
;; back end which handles the mail (currently nnml, nnimap and
;;; Code:
+(eval-when-compile (require 'cl)) ;For (pop (cdr ogroup)).
+
(require 'nnoo)
(require 'gnus-group)
(require 'gnus-sum)
(setq nnmairix-current-server server)
(nnoo-change-server 'nnmairix server definitions))
-(deffoo nnmairix-request-group (group &optional server fast)
+(deffoo nnmairix-request-group (group &optional server fast info)
;; Call mairix and request group on back end server
(when server (nnmairix-open-server server))
(let* ((qualgroup (if server
nil)
((not query)
;; No query -> return empty group
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(erase-buffer)
(insert (concat "211 0 1 0 " group))
t))
(when (eq nnmairix-backend 'nnml)
(when nnmairix-rename-files-for-nnml
(nnmairix-rename-files-consecutively mfolder))
- (nnml-generate-nov-databases-directory mfolder))
+ (nnml-generate-nov-databases-directory mfolder nil t))
(nnmairix-call-backend
"request-scan" folder nnmairix-backend-server)
(if (and fast allowfast)
(nnmairix-request-group-with-article-number-correction
folder qualgroup)))
((and (= rval 1)
- (save-excursion (set-buffer nnmairix-mairix-output-buffer)
- (goto-char (point-min))
- (looking-at "^Matched 0 messages")))
+ (with-current-buffer nnmairix-mairix-output-buffer
+ (goto-char (point-min))
+ (looking-at "^Matched 0 messages")))
;; No messages found -> return empty group
(nnheader-message 5 "Mairix: No matches found.")
(set-buffer nntp-server-buffer)
(mapcar
(lambda (arg) (- arg numcorr))
articles)))
- (setq rval (nnmairix-call-backend
- "retrieve-headers" articles folder nnmairix-backend-server fetch-old))
- (when (eq rval 'nov)
- (nnmairix-replace-group-and-numbers articles folder group numcorr)
- rval)))
+ (setq rval
+ (if (eq nnmairix-backend 'nnimap)
+ (let ((gnus-nov-is-evil t))
+ (nnmairix-call-backend
+ "retrieve-headers" articles folder nnmairix-backend-server fetch-old))
+ (nnmairix-call-backend
+ "retrieve-headers" articles folder nnmairix-backend-server fetch-old)))
+ (nnmairix-replace-group-and-numbers articles folder group numcorr rval)
+ rval))
(deffoo nnmairix-request-article (article &optional group server to-buffer)
(when server (nnmairix-open-server server))
(when server (nnmairix-open-server server))
(if (nnmairix-call-backend "request-list" nnmairix-backend-server)
(let (cpoint cur qualgroup folder)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(goto-char (point-min))
(setq cpoint (point))
(while (re-search-forward nnmairix-group-regexp (point-max) t)
t)
nil))
+;; Silence byte-compiler.
+(defvar gnus-registry-install)
+(autoload 'gnus-registry-fetch-group "gnus-registry")
+(autoload 'gnus-registry-fetch-groups "gnus-registry")
+(autoload 'gnus-registry-add-group "gnus-registry")
+
(deffoo nnmairix-request-set-mark (group actions &optional server)
(when server
(nnmairix-open-server server))
(when (or (eq nnmairix-propagate-marks-upon-close t)
(and (eq nnmairix-propagate-marks-upon-close 'ask)
(y-or-n-p "Propagate marks to original articles? ")))
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(nnmairix-propagate-marks)
;; update mairix group
(gnus-group-jump-to-group qualgroup)
(gnus-group-get-new-news-this-group))))))
-(deffoo nnmairix-request-update-info (group info &optional server)
+(autoload 'nnimap-request-update-info-internal "nnimap")
+
+(deffoo nnmairix-request-marks (group info &optional server)
;; propagate info from underlying IMAP folder to nnmairix group
;; This is currently experimental and must be explicitly activated
;; with nnmairix-propagate-marks-to-nnmairix-group
All necessary information will be queried from the user."
(interactive)
(let* ((name (read-string "Name of the mairix server: "))
- (server (completing-read "Back end server (TAB for completion): "
- (nnmairix-get-valid-servers)))
+ (server (gnus-completing-read "Back end server"
+ (nnmairix-get-valid-servers) t))
(mairix (read-string "Command to call mairix: " "mairix"))
(defaultgroup (read-string "Default search group: "))
(backend (symbol-name (car (gnus-server-to-method server))))
(if server
(if (gnus-buffer-live-p gnus-article-buffer)
(progn
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(gnus-summary-toggle-header 1)
(setq mid (message-fetch-field "Message-ID")))
(while (string-match "[<>]" mid)
(if server
(if (gnus-buffer-live-p gnus-article-buffer)
(progn
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(gnus-summary-toggle-header 1)
(setq from (cadr (gnus-extract-address-components
(gnus-fetch-field "From"))))
(when (nnmairix-call-backend
"request-list" nnmairix-backend-server)
(let (cur qualgroup folder)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(goto-char (point-min))
(while (re-search-forward nnmairix-group-regexp (point-max) t)
(setq cur (match-string 0)
(set-process-sentinel (apply 'start-process args)
'nnmairix-sentinel-mairix-update-finished))))))
-;; Silence byte-compiler.
-(defvar gnus-registry-install)
-(autoload 'gnus-registry-fetch-group "gnus-registry")
-
(defun nnmairix-group-delete-recreate-this-group ()
"Deletes and recreates group on the back end.
-You can use this function on nnmairix groups which continously
+You can use this function on nnmairix groups which continuously
show wrong article counts."
(interactive)
(let* ((group (gnus-group-group-name))
(push (list (car ogroup) (list (list number) (nth 1 mid-marks) (nth 2 mid-marks)))
number-cache)))))
;; now we set the marks
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(nnheader-message 5 "nnmairix: Propagating marks...")
(dolist (cur number-cache)
(setq method (gnus-find-method-for-group (car cur)))
If SKIPDEFAULT is t, the default search group will not be
updated.
If UPDATEDB is t, database for SERVERNAME will be updated first."
- (interactive (list (completing-read "Update groups on server: "
+ (interactive (list (gnus-completing-read "Update groups on server"
(nnmairix-get-nnmairix-servers))))
(save-excursion
(when (string-match ".*:\\(.*\\)" servername)
(unless (and skipdefault
(string= (car cur) default))
(gnus-group-jump-to-group (car cur))
- (gnus-group-get-new-news-this-group)))))))
+ (gnus-group-mark-group 1)))
+ (gnus-group-get-new-news-this-group)))))
(defun nnmairix-remove-tick-mark-original-article ()
"Remove tick mark from original article.
"Call mairix binary with COMMAND, using FOLDER and SEARCHQUERY.
If THREADS is non-nil, enable full threads."
(let ((args (cons (car command) '(nil t nil))))
- (save-excursion
- (set-buffer
- (get-buffer-create nnmairix-mairix-output-buffer))
+ (with-current-buffer
+ (get-buffer-create nnmairix-mairix-output-buffer)
(erase-buffer)
(when (> (length command) 1)
(setq args (append args (cdr command))))
(defun nnmairix-call-mairix-binary-raw (command query)
"Call mairix binary with COMMAND and QUERY in raw mode."
(let ((args (cons (car command) '(nil t nil))))
- (save-excursion
- (set-buffer
- (get-buffer-create nnmairix-mairix-output-buffer))
+ (with-current-buffer
+ (get-buffer-create nnmairix-mairix-output-buffer)
(erase-buffer)
(when (> (length command) 1)
(setq args (append args (cdr command))))
(while
(equal '("")
(setq nnmairix-last-server
- (list (completing-read "Server: " openedserver nil 1
+ (list (gnus-completing-read "Server" openedserver t
(or nnmairix-last-server
"nnmairix:"))))))
nnmairix-last-server)
(setq cur lastplusone))
(setq lastplusone (1+ cur)))))
-(defun nnmairix-replace-group-and-numbers (articles backendgroup mairixgroup numc)
+(defun nnmairix-replace-group-and-numbers (articles backendgroup mairixgroup numc type)
"Replace folder names in Xref header and correct article numbers.
Do this for all ARTICLES on BACKENDGROUP. Replace using
-MAIRIXGROUP. NUMC contains values for article number correction."
- (let ((buf (get-buffer-create " *nnmairix buffer*"))
- (corr (not (zerop numc)))
- (name (buffer-name nntp-server-buffer))
- header cur xref)
- (save-excursion
- (set-buffer buf)
- (erase-buffer)
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (nnheader-message 7 "nnmairix: Rewriting headers...")
- (mapc
- (lambda (article)
- (when (or (looking-at (number-to-string article))
- (nnheader-find-nov-line article))
- (setq cur (nnheader-parse-nov))
- (when corr
- (setq article (+ (mail-header-number cur) numc))
- (mail-header-set-number cur article))
- (setq xref (mail-header-xref cur))
- (when (and (stringp xref)
- (string-match (format "[ \t]%s:[0-9]+" backendgroup) xref))
- (setq xref (replace-match (format " %s:%d" mairixgroup article) t nil xref))
- (mail-header-set-xref cur xref))
- (set-buffer buf)
- (nnheader-insert-nov cur)
- (set-buffer nntp-server-buffer)
- (when (not (eobp))
- (forward-line 1))))
- articles)
- (nnheader-message 7 "nnmairix: Rewriting headers... done")
- (kill-buffer nntp-server-buffer)
- (set-buffer buf)
- (rename-buffer name)
- (setq nntp-server-buffer buf))))
+MAIRIXGROUP. NUMC contains values for article number correction.
+TYPE is either 'nov or 'headers."
+ (nnheader-message 7 "nnmairix: Rewriting headers...")
+ (cond
+ ((eq type 'nov)
+ (let ((buf (get-buffer-create " *nnmairix buffer*"))
+ (corr (not (zerop numc)))
+ (name (buffer-name nntp-server-buffer))
+ header cur xref)
+ (with-current-buffer buf
+ (erase-buffer)
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (mapc
+ (lambda (article)
+ (when (or (looking-at (number-to-string article))
+ (nnheader-find-nov-line article))
+ (setq cur (nnheader-parse-nov))
+ (when corr
+ (setq article (+ (mail-header-number cur) numc))
+ (mail-header-set-number cur article))
+ (setq xref (mail-header-xref cur))
+ (when (and (stringp xref)
+ (string-match (format "[ \t]%s:[0-9]+" backendgroup) xref))
+ (setq xref (replace-match (format " %s:%d" mairixgroup article) t nil xref))
+ (mail-header-set-xref cur xref))
+ (set-buffer buf)
+ (nnheader-insert-nov cur)
+ (set-buffer nntp-server-buffer)
+ (when (not (eobp))
+ (forward-line 1))))
+ articles)
+ (kill-buffer nntp-server-buffer)
+ (set-buffer buf)
+ (rename-buffer name)
+ (setq nntp-server-buffer buf))))
+ ((and (eq type 'headers)
+ (not (zerop numc)))
+ (with-current-buffer nntp-server-buffer
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "^[23][0-9]+ \\([0-9]+\\)" nil t)
+ (replace-match (number-to-string
+ (+ (string-to-number (match-string 1)) numc))
+ t t nil 1))))))
+ (nnheader-message 7 "nnmairix: Rewriting headers... done"))
(defun nnmairix-backend-to-server (server)
"Return nnmairix server most probably responsible for back end SERVER.
(when (not found)
(setq mairixserver
(gnus-server-to-method
- (completing-read
- (format "Cannot determine which nnmairix server indexes %s. Please specify: "
+ (gnus-completing-read
+ (format "Cannot determine which nnmairix server indexes %s. Please specify"
(gnus-method-to-server server))
- (nnmairix-get-nnmairix-servers) nil nil "nnmairix:")))
+ (nnmairix-get-nnmairix-servers) nil "nnmairix:")))
;; Save result in parameter of default search group so that
;; we don't have to ask again
(setq defaultgroup (gnus-group-prefixed-name
(defun nnmairix-replace-illegal-chars (header)
"Replace illegal characters in HEADER for mairix query."
(when header
- (if (> emacs-major-version 20)
- (while (string-match "[^-.@/,& [:alnum:]]" header)
- (setq header (replace-match "" t t header)))
- (while (string-match "[[]{}:<>]" header)
- (setq header (replace-match "" t t header))))
+ (while (string-match "[^-.@/,& [:alnum:]]" header)
+ (setq header (replace-match "" t t header)))
(while (string-match "[-& ]" header)
(setq header (replace-match "," t t header)))
- header))
+ header))
(defun nnmairix-group-toggle-parameter (group parameter description &optional par)
"Toggle on GROUP a certain PARAMETER.
(let ((server (nth 1 gnus-current-select-method))
mid rval group allgroups)
;; get message id
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(gnus-summary-toggle-header 1)
(setq mid (message-fetch-field "Message-ID"))
;; first check the registry (if available)
(gnus-registry-add-group mid cur)))))
(if (> (length allgroups) 1)
(setq group
- (completing-read
- "Message exists in more than one group. Choose: "
- allgroups nil t))
+ (gnus-completing-read
+ "Message exists in more than one group. Choose"
+ allgroups t))
(setq group (car allgroups))))
(if group
;; show article in summary buffer
(nnmairix-open-server server)
(while (string-match "[<>]" mid)
(setq mid (replace-match "" t t mid)))
+ ;; mairix somehow does not like '$' in message-id
+ (when (string-match "\\$" mid)
+ (setq mid (concat mid "=")))
+ (while (string-match "\\$" mid)
+ (setq mid (replace-match "=," t t mid)))
(let (allgroups)
(if (zerop (nnmairix-call-mairix-binary-raw
(split-string nnmairix-mairix-command)
(list (concat "m:" mid))))
- (save-excursion
- (set-buffer nnmairix-mairix-output-buffer)
+ (with-current-buffer nnmairix-mairix-output-buffer
(goto-char (point-min))
(while (re-search-forward "^/.*$" nil t)
(push (nnmairix-get-group-from-file-path (match-string 0))
(gnus-group-prefixed-name group (car cur))
allgroups))))
(if (> (length allgroups) 1)
- (setq group (completing-read
- "Group %s exists on more than one IMAP server. Choose: "
- allgroups nil t))
+ (setq group (gnus-completing-read
+ "Group %s exists on more than one IMAP server. Choose"
+ allgroups t))
(setq group (car allgroups))))
group))
(provide 'nnmairix)
-;; arch-tag: bb187498-b229-4a55-8c07-6d3f80713e94
;;; nnmairix.el ends here