2008-02-27 06:22:10 +00:00
|
|
|
;;; nnmairix.el --- Mairix back end for Gnus, the Emacs newsreader
|
|
|
|
|
|
|
|
|
|
;; Copyright (C) 2007, 2008 Free Software Foundation, Inc.
|
|
|
|
|
|
|
|
|
|
;; Author: David Engster <dengste@eml.cc>
|
|
|
|
|
;; Keywords: mail searching
|
|
|
|
|
;; Version: 0.5
|
|
|
|
|
|
2008-02-27 08:57:49 +00:00
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
|
|
|
|
|
|
;; GNU Emacs is free software; you can redistribute it and/or modify
|
2008-02-27 06:22:10 +00:00
|
|
|
;; it under the terms of the GNU General Public License as published by
|
2008-02-27 08:57:49 +00:00
|
|
|
;; the Free Software Foundation; either version 3, or (at your option)
|
2008-02-27 06:22:10 +00:00
|
|
|
;; any later version.
|
|
|
|
|
|
2008-02-27 08:57:49 +00:00
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
2008-02-27 06:22:10 +00:00
|
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
;; GNU General Public License for more details.
|
|
|
|
|
|
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
2008-02-27 08:57:49 +00:00
|
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
|
|
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
2008-02-27 06:22:10 +00:00
|
|
|
;; Boston, MA 02110-1301, USA.
|
|
|
|
|
|
|
|
|
|
;;; 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
|
|
|
|
|
;; "smart folders", e.g. folders which are associated with search
|
|
|
|
|
;; queries. Of course, you can also use this back end just for
|
|
|
|
|
;; calling mairix with some search query.
|
|
|
|
|
;;
|
|
|
|
|
;; 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
|
2008-02-27 08:57:49 +00:00
|
|
|
;;
|
2008-02-27 06:22:10 +00:00
|
|
|
;; 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
|
|
|
|
|
;; nnmaildir were tested). I know this is all a bit hacky, but so far
|
|
|
|
|
;; it works for me. This is the first back end I've written for Gnus,
|
|
|
|
|
;; so I'd appreciate any comments, suggestions, bug reports (and, of
|
|
|
|
|
;; course, patches) for improving nnmairix.
|
|
|
|
|
|
|
|
|
|
;; nnmairix does not use an active file, since I wanted to contain the
|
|
|
|
|
;; back end "inside Gnus" as much as possible without the need of an
|
|
|
|
|
;; external file. It stores the query/folder information in the group
|
|
|
|
|
;; parameters instead. This also implies that once you kill a mairix
|
|
|
|
|
;; group, it's gone for good. I don't think that this is really
|
|
|
|
|
;; problematic, since I don't see the need in unsubscribing and
|
|
|
|
|
;; re-subscribing search groups
|
|
|
|
|
|
|
|
|
|
;; Every mairix server is "responsible" for one mairix installation,
|
|
|
|
|
;; i.e. you can have several mairix servers for different mairix
|
|
|
|
|
;; configurations. Not that I think anyone will actually do this, but
|
|
|
|
|
;; I thought it would be a "nice to have feature"...
|
|
|
|
|
|
|
|
|
|
;; KNOWN BUGS:
|
|
|
|
|
;; * When using Maildir: path and filename of a mail can change due to
|
|
|
|
|
;; reading/replying/etc. This can lead to dangling symlinks in
|
|
|
|
|
;; nnmairix groups and it depends on the back end how well it deals
|
|
|
|
|
;; with that (some IMAP servers out there may not be amused). Update the
|
|
|
|
|
;; database ('G b u') and the group to fix it.
|
|
|
|
|
;; * Mairix does only support us-ascii characters.
|
|
|
|
|
|
|
|
|
|
;; TODO/MISSING FEATURES:
|
|
|
|
|
;; * Possibility to propagate flags like seen, replied, ticked
|
|
|
|
|
;; to original message
|
|
|
|
|
;; * Support of more back ends (nnmh, nnfolder, nnmbox...)?
|
|
|
|
|
;; * Maybe use an active file instead of group parameters?
|
|
|
|
|
;; * Use "-a" when updating groups which are not newly created
|
2008-02-27 08:57:49 +00:00
|
|
|
|
2008-02-27 06:22:10 +00:00
|
|
|
;;; Changelog:
|
|
|
|
|
;;
|
|
|
|
|
;; 02/06/2008 - version 0.5
|
2008-02-27 08:57:49 +00:00
|
|
|
;;
|
2008-02-27 06:22:10 +00:00
|
|
|
;; * New function: nnmairix-goto-original-article. Uses the
|
|
|
|
|
;; registry or the mail file path for determining original group.
|
2008-02-27 08:57:49 +00:00
|
|
|
;;
|
2008-02-27 06:22:10 +00:00
|
|
|
;; * Deal with empty Xref header
|
|
|
|
|
;;
|
|
|
|
|
;; * Changed summary mode keybindings since the old ones were
|
|
|
|
|
;; already taken
|
|
|
|
|
;;
|
|
|
|
|
;; (Thanks to Tassilo Horn and Ted Zlatanov for their help)
|
|
|
|
|
;;
|
|
|
|
|
;; 01/07/2008 - version 0.4
|
|
|
|
|
;;
|
|
|
|
|
;; * New/fixed doc strings and code cleanup.
|
|
|
|
|
;;
|
|
|
|
|
;; 18/11/2007 - version 0.3
|
|
|
|
|
;;
|
|
|
|
|
;; * Fixed bugs when dealing with nnml and native servers
|
2008-02-27 08:57:49 +00:00
|
|
|
;;
|
2008-02-27 06:22:10 +00:00
|
|
|
;; * Make variables customizable
|
|
|
|
|
;;
|
|
|
|
|
;; 10/10/2007 - version 0.2
|
|
|
|
|
;;
|
|
|
|
|
;; * Use nnml-directory/directory server variables for nnml and
|
|
|
|
|
;; nnmaildir backends as path for search folders. This way it
|
|
|
|
|
;; becomes independent of 'base' setting in .mairixirc (but not for
|
|
|
|
|
;; nnimap).
|
|
|
|
|
;;
|
|
|
|
|
;; * As a result: Changed nnmairix-backend-to-server so that user
|
|
|
|
|
;; is asked when more than one nnmairix server exists and we do not
|
|
|
|
|
;; know which one is responsible for current backend.
|
|
|
|
|
;;
|
|
|
|
|
;; * Rename files when using nnml backends so that there are no
|
|
|
|
|
;; holes in article numbers. This should fix all problems regarding
|
|
|
|
|
;; wrong article counts with nnml.
|
|
|
|
|
;;
|
|
|
|
|
;; * More commands for creating queries (using widgets or the
|
|
|
|
|
;; minibuffer).
|
|
|
|
|
;;
|
|
|
|
|
;; * Fixed bug in nnmairix-create-search-group-from-message
|
|
|
|
|
;;
|
|
|
|
|
;; * Changed copyright to FSF
|
|
|
|
|
;;
|
|
|
|
|
;; (Thanks to Georg C. F. Greve and Bastien for suggestions and
|
|
|
|
|
;; ideas!)
|
|
|
|
|
;;
|
|
|
|
|
;; 10/03/2007 - version 0.1 - first release
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
|
|
|
(require 'nnoo)
|
|
|
|
|
(require 'gnus-group)
|
|
|
|
|
(require 'gnus-sum)
|
|
|
|
|
(require 'message)
|
|
|
|
|
(require 'nnml)
|
|
|
|
|
(require 'widget)
|
|
|
|
|
|
|
|
|
|
(nnoo-declare nnmairix)
|
|
|
|
|
|
|
|
|
|
;;; === Keymaps
|
|
|
|
|
|
|
|
|
|
;; Group mode
|
|
|
|
|
(defun nnmairix-group-mode-hook ()
|
|
|
|
|
"Nnmairix group mode keymap."
|
|
|
|
|
(define-key gnus-group-mode-map
|
|
|
|
|
(kbd "G b") (make-sparse-keymap))
|
|
|
|
|
(define-key gnus-group-mode-map
|
|
|
|
|
(kbd "G b g") 'nnmairix-create-search-group)
|
|
|
|
|
(define-key gnus-group-mode-map
|
|
|
|
|
(kbd "G b c") 'nnmairix-create-server-and-default-group)
|
|
|
|
|
(define-key gnus-group-mode-map
|
|
|
|
|
(kbd "G b q") 'nnmairix-group-change-query-this-group)
|
|
|
|
|
(define-key gnus-group-mode-map
|
|
|
|
|
(kbd "G b t") 'nnmairix-group-toggle-threads-this-group)
|
|
|
|
|
(define-key gnus-group-mode-map
|
|
|
|
|
(kbd "G b u") 'nnmairix-update-database)
|
|
|
|
|
(define-key gnus-group-mode-map
|
|
|
|
|
(kbd "G b s") 'nnmairix-search)
|
|
|
|
|
(define-key gnus-group-mode-map
|
|
|
|
|
(kbd "G b i") 'nnmairix-search-interactive)
|
|
|
|
|
(define-key gnus-group-mode-map
|
|
|
|
|
(kbd "G b m") 'nnmairix-widget-search))
|
|
|
|
|
|
|
|
|
|
;; Summary mode
|
|
|
|
|
(defun nnmairix-summary-mode-hook ()
|
|
|
|
|
"Nnmairix summary mode keymap."
|
|
|
|
|
(define-key gnus-summary-mode-map
|
|
|
|
|
(kbd "$ t") 'nnmairix-search-thread-this-article)
|
|
|
|
|
(define-key gnus-summary-mode-map
|
|
|
|
|
(kbd "$ f") 'nnmairix-search-from-this-article)
|
|
|
|
|
(define-key gnus-summary-mode-map
|
|
|
|
|
(kbd "$ m") 'nnmairix-widget-search-from-this-article)
|
|
|
|
|
(define-key gnus-summary-mode-map
|
|
|
|
|
(kbd "$ g") 'nnmairix-create-search-group-from-message)
|
|
|
|
|
(define-key gnus-summary-mode-map
|
|
|
|
|
(kbd "$ o") 'nnmairix-goto-original-article))
|
|
|
|
|
|
|
|
|
|
(add-hook 'gnus-group-mode-hook 'nnmairix-group-mode-hook)
|
|
|
|
|
(add-hook 'gnus-summary-mode-hook 'nnmairix-summary-mode-hook)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; Customizable stuff
|
|
|
|
|
|
|
|
|
|
(defgroup nnmairix nil
|
|
|
|
|
"Backend for the Mairix mail search engine."
|
|
|
|
|
:group 'gnus)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmairix-group-prefix "zz_mairix"
|
|
|
|
|
"Prefix for mairix search groups on back end server.
|
|
|
|
|
nnmairix will create these groups automatically on the back end
|
|
|
|
|
server for each nnmairix search group. The name on the back end
|
|
|
|
|
server will be this prefix plus a random number. You can delete
|
|
|
|
|
unused nnmairix groups on the back end using
|
|
|
|
|
`nnmairix-purge-old-groups'."
|
2008-02-27 08:57:49 +00:00
|
|
|
:version "23.1"
|
2008-02-27 06:22:10 +00:00
|
|
|
:type 'string
|
|
|
|
|
:group 'nnmairix)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmairix-mairix-output-buffer "*mairix output*"
|
|
|
|
|
"Buffer used for mairix output."
|
2008-02-27 08:57:49 +00:00
|
|
|
:version "23.1"
|
2008-02-27 06:22:10 +00:00
|
|
|
:type 'string
|
|
|
|
|
:group 'nnmairix)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmairix-customize-query-buffer "*mairix query*"
|
|
|
|
|
"Name of the buffer for customizing Mairix queries."
|
2008-02-27 08:57:49 +00:00
|
|
|
:version "23.1"
|
2008-02-27 06:22:10 +00:00
|
|
|
:type 'string
|
|
|
|
|
:group 'nnmairix)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmairix-mairix-update-options '("-F" "-Q")
|
|
|
|
|
"Options when calling mairix for updating the database.
|
|
|
|
|
The default is '-F' and '-Q' for making updates faster. You
|
|
|
|
|
should call mairix without these options from time to
|
|
|
|
|
time (e.g. via cron job)."
|
2008-02-27 08:57:49 +00:00
|
|
|
:version "23.1"
|
2008-02-27 06:22:10 +00:00
|
|
|
:type '(repeat string)
|
|
|
|
|
:group 'nnmairix)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmairix-mairix-synchronous-update nil
|
|
|
|
|
"Set this to t if you want Emacs to wait for mairix updating the database."
|
2008-02-27 08:57:49 +00:00
|
|
|
:version "23.1"
|
2008-02-27 06:22:10 +00:00
|
|
|
:type 'boolean
|
|
|
|
|
:group 'nnmairix)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmairix-rename-files-for-nnml t
|
|
|
|
|
"Rename nnml mail files so that they are consecutively numbered.
|
|
|
|
|
When using nnml as backend, mairix might produce holes in the
|
|
|
|
|
article numbers which will produce wrong article counts by
|
|
|
|
|
Gnus. This option controls whether nnmairix should rename the
|
|
|
|
|
files consecutively."
|
2008-02-27 08:57:49 +00:00
|
|
|
:version "23.1"
|
2008-02-27 06:22:10 +00:00
|
|
|
:type 'boolean
|
|
|
|
|
:group 'nnmairix)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmairix-widget-fields-list
|
|
|
|
|
'(("from" "f" "From") ("to" "t" "To") ("cc" "c" "Cc")
|
|
|
|
|
("subject" "s" "Subject") ("to" "tc" "To or Cc")
|
|
|
|
|
("from" "a" "Address") (nil "b" "Body") (nil "n" "Attachment")
|
|
|
|
|
("Message-ID" "m" "Message ID") (nil "s" "Size") (nil "d" "Date"))
|
|
|
|
|
"Fields that should be editable during interactive query customization.
|
|
|
|
|
|
|
|
|
|
Header, corresponding mairix command and description for editable
|
|
|
|
|
fields in interactive query customization. The header specifies
|
|
|
|
|
which header contents should be inserted into the editable field
|
|
|
|
|
when creating a Mairix query based on the current message (can be
|
|
|
|
|
nil for disabling this)."
|
2008-02-27 08:57:49 +00:00
|
|
|
:version "23.1"
|
2008-02-27 06:22:10 +00:00
|
|
|
:type '(repeat (list
|
|
|
|
|
(choice :tag "Field"
|
|
|
|
|
(const :tag "none" nil)
|
|
|
|
|
(const :tag "From" "from")
|
|
|
|
|
(const :tag "To" "to")
|
|
|
|
|
(const :tag "Cc" "cc")
|
|
|
|
|
(const :tag "Subject" "subject")
|
|
|
|
|
(const :tag "Message ID" "Message-ID"))
|
|
|
|
|
(string :tag "Command")
|
|
|
|
|
(string :tag "Description")))
|
|
|
|
|
:group 'nnmairix)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmairix-widget-select-window-function
|
|
|
|
|
(lambda () (select-window (get-largest-window)))
|
|
|
|
|
"Function for selecting the window for customizing the mairix query.
|
|
|
|
|
The default chooses the largest window in the current frame."
|
2008-02-27 08:57:49 +00:00
|
|
|
:version "23.1"
|
2008-02-27 06:22:10 +00:00
|
|
|
:type 'function
|
|
|
|
|
:group 'nnmairix)
|
|
|
|
|
|
|
|
|
|
;; ==== Other variables
|
|
|
|
|
|
|
|
|
|
(defvar nnmairix-widget-other
|
|
|
|
|
'(threads flags)
|
|
|
|
|
"Other editable mairix commands when using customization widgets.
|
|
|
|
|
Currently there are 'threads and 'flags.")
|
|
|
|
|
|
|
|
|
|
(defvar nnmairix-interactive-query-parameters
|
|
|
|
|
'((?f "from" "f" "From") (?t "to" "t" "To") (?c "to" "tc" "To or Cc")
|
|
|
|
|
(?a "from" "a" "Address") (?s "subject" "s" "Subject") (?b nil "b" "Body")
|
|
|
|
|
(?d nil "d" "Date") (?n nil "n" "Attachment"))
|
|
|
|
|
"Things that should be editable during interactive query generation.
|
|
|
|
|
Every list element consists of the following entries: Keystroke,
|
|
|
|
|
message field (if any), mairix command and description.")
|
|
|
|
|
|
|
|
|
|
(defvar nnmairix-delete-and-create-on-change '(nnimap nnmaildir nnml)
|
|
|
|
|
"Controls on which backends groups should be deleted and re-created.
|
|
|
|
|
This variable is a list of back ends where the search group should
|
|
|
|
|
be completely deleted and re-created when the query or thread
|
|
|
|
|
parameter changes. I know this is rather \"brute force\" and maybe
|
|
|
|
|
even dangerous (you have backups, right?), but it should be used at
|
|
|
|
|
least for nnimap since some IMAP servers are really not amused when
|
|
|
|
|
mailbox content changes behind their back. It usually also corrects
|
|
|
|
|
the problem of \"holes\" in the article numbers which often lead to a
|
|
|
|
|
wrong count of total articles shown by Gnus.")
|
|
|
|
|
|
|
|
|
|
;;; === Server variables
|
|
|
|
|
|
|
|
|
|
(defvoo nnmairix-backend nil
|
|
|
|
|
"Backend where mairix stores its searches.")
|
|
|
|
|
|
|
|
|
|
(defvoo nnmairix-backend-server nil
|
|
|
|
|
"Name of the server where mairix stores its searches.")
|
|
|
|
|
|
|
|
|
|
(defvoo nnmairix-mairix-command "mairix"
|
|
|
|
|
"Command to call mairix for this nnmairix server.")
|
|
|
|
|
|
|
|
|
|
(defvoo nnmairix-hidden-folders nil
|
|
|
|
|
"Set this to t if the back end server uses hidden directories for
|
|
|
|
|
its maildir mail folders (e.g. the Dovecot IMAP server or mutt).")
|
|
|
|
|
|
|
|
|
|
(defvoo nnmairix-default-group nil
|
|
|
|
|
"Default search group. This is the group which is used for all
|
|
|
|
|
temporary searches, e.g. nnmairix-search.")
|
|
|
|
|
|
|
|
|
|
;;; === Internal variables
|
|
|
|
|
|
|
|
|
|
;; Regexp for mairix groups on back end
|
|
|
|
|
(setq nnmairix-group-regexp (format "%s-\\(.*\\)-[0-9]+" nnmairix-group-prefix))
|
|
|
|
|
|
|
|
|
|
;; Back ends (hopefully...) supported by nnmairix.
|
|
|
|
|
;; Other backends might or might not work.
|
|
|
|
|
(setq nnmairix-valid-backends '(nnimap nnml nnmaildir))
|
|
|
|
|
|
|
|
|
|
;; Last chosen server
|
|
|
|
|
(setq nnmairix-last-server nil)
|
|
|
|
|
|
|
|
|
|
;; Current server
|
|
|
|
|
(setq nnmairix-current-server nil)
|
|
|
|
|
|
|
|
|
|
;;; === Gnus backend functions
|
|
|
|
|
|
|
|
|
|
(nnoo-define-basics nnmairix)
|
|
|
|
|
|
|
|
|
|
(gnus-declare-backend "nnmairix" 'mail 'address)
|
|
|
|
|
|
|
|
|
|
(deffoo nnmairix-open-server (server &optional definitions)
|
|
|
|
|
;; just set server variables
|
|
|
|
|
(setq nnmairix-current-server server)
|
|
|
|
|
(nnoo-change-server 'nnmairix server definitions))
|
|
|
|
|
|
|
|
|
|
(deffoo nnmairix-request-group (group &optional server fast)
|
|
|
|
|
;; Call mairix and request group on back end server
|
|
|
|
|
(when server (nnmairix-open-server server))
|
|
|
|
|
(let* ((qualgroup (if server
|
|
|
|
|
(gnus-group-prefixed-name group (list 'nnmairix server))
|
|
|
|
|
group))
|
|
|
|
|
(query (gnus-group-get-parameter qualgroup 'query t))
|
|
|
|
|
(folder (gnus-group-get-parameter qualgroup 'folder))
|
|
|
|
|
(threads (gnus-group-get-parameter qualgroup 'threads))
|
|
|
|
|
(backendmethod (gnus-server-to-method
|
|
|
|
|
(format "%s:%s" (symbol-name nnmairix-backend)
|
|
|
|
|
nnmairix-backend-server)))
|
|
|
|
|
rval mfolder folderpath)
|
|
|
|
|
(cond
|
|
|
|
|
((not folder)
|
|
|
|
|
;; No folder parameter -> error
|
|
|
|
|
(nnheader-report 'nnmairix "Check folder parameter for group %s" group)
|
|
|
|
|
nil)
|
|
|
|
|
((not query)
|
|
|
|
|
;; No query -> return empty group
|
|
|
|
|
(save-excursion
|
|
|
|
|
(set-buffer nntp-server-buffer)
|
|
|
|
|
(erase-buffer)
|
|
|
|
|
(insert (concat "211 0 1 0 " group))
|
|
|
|
|
t))
|
|
|
|
|
(t
|
|
|
|
|
;; For maildir++ folders: create a hidden directory (prepend dot)
|
|
|
|
|
(setq mfolder (if (and nnmairix-hidden-folders
|
|
|
|
|
(not (string-match "^\\." folder)))
|
|
|
|
|
(concat "." folder)
|
|
|
|
|
folder))
|
|
|
|
|
;; For nnml and nnmaildir, precede mfolder with directory where mail
|
|
|
|
|
;; is actually stored so that it's independent of 'base' setting
|
|
|
|
|
;; in .mairixrc.
|
|
|
|
|
(when (eq nnmairix-backend 'nnml)
|
|
|
|
|
(setq folderpath (cadr (assoc 'nnml-directory backendmethod)))
|
|
|
|
|
;; if nnml-directory is not explicitly set, use global value
|
|
|
|
|
(when (not folderpath)
|
|
|
|
|
(setq folderpath nnml-directory)))
|
|
|
|
|
(when (eq nnmairix-backend 'nnmaildir)
|
|
|
|
|
(setq folderpath
|
|
|
|
|
(cadr (assoc 'directory backendmethod))))
|
|
|
|
|
(when folderpath
|
|
|
|
|
(setq mfolder
|
|
|
|
|
(concat
|
|
|
|
|
(file-name-as-directory
|
|
|
|
|
(expand-file-name
|
|
|
|
|
folderpath))
|
|
|
|
|
mfolder)))
|
|
|
|
|
;; If (not fast), call Mairix binary
|
|
|
|
|
(setq rval
|
|
|
|
|
(if fast 0
|
|
|
|
|
(nnmairix-call-mairix-binary
|
|
|
|
|
(split-string nnmairix-mairix-command)
|
|
|
|
|
mfolder query threads)))
|
|
|
|
|
;; Check return value
|
|
|
|
|
(cond
|
|
|
|
|
((zerop rval) ; call was succesful
|
|
|
|
|
(nnmairix-call-backend
|
|
|
|
|
"open-server" nnmairix-backend-server)
|
|
|
|
|
;; If we're dealing with nnml, rename files
|
|
|
|
|
;; consecutively and make new active file for this
|
|
|
|
|
;; group
|
|
|
|
|
(when (eq nnmairix-backend 'nnml)
|
|
|
|
|
(when nnmairix-rename-files-for-nnml
|
|
|
|
|
(nnmairix-rename-files-consecutively mfolder))
|
|
|
|
|
(nnml-generate-nov-databases-directory mfolder))
|
|
|
|
|
(nnmairix-call-backend
|
|
|
|
|
"request-scan" folder nnmairix-backend-server)
|
|
|
|
|
(if fast
|
|
|
|
|
t
|
|
|
|
|
(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")))
|
|
|
|
|
;; No messages found -> return empty group
|
|
|
|
|
(nnheader-message 5 "Mairix: No matches found.")
|
|
|
|
|
(set-buffer nntp-server-buffer)
|
|
|
|
|
(erase-buffer)
|
|
|
|
|
(insert (concat "211 0 1 0 " group))
|
|
|
|
|
t)
|
|
|
|
|
;; Everything else is an error
|
|
|
|
|
(t
|
|
|
|
|
(nnheader-report
|
|
|
|
|
'nnmairix "Error running marix. See buffer %s for details"
|
|
|
|
|
nnmairix-mairix-output-buffer)
|
|
|
|
|
nil))))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(deffoo nnmairix-request-create-group (group &optional server args)
|
|
|
|
|
(let ((qualgroup (if server (gnus-group-prefixed-name group (list 'nnmairix server))
|
|
|
|
|
group))
|
|
|
|
|
(exist t)
|
|
|
|
|
(count 0)
|
|
|
|
|
groupname info)
|
|
|
|
|
(when server (nnmairix-open-server server))
|
|
|
|
|
(gnus-group-add-parameter qualgroup '(query . nil))
|
|
|
|
|
(gnus-group-add-parameter qualgroup '(threads . nil))
|
|
|
|
|
(while exist
|
|
|
|
|
(setq count (1+ count))
|
|
|
|
|
(setq groupname (format "%s-%s-%s" nnmairix-group-prefix group
|
|
|
|
|
(number-to-string count)))
|
|
|
|
|
(setq exist (nnmairix-call-backend
|
|
|
|
|
"request-group" groupname nnmairix-backend-server)))
|
|
|
|
|
(nnmairix-call-backend
|
|
|
|
|
"request-create-group" groupname nnmairix-backend-server)
|
|
|
|
|
(gnus-group-add-parameter qualgroup '(folder . nil))
|
|
|
|
|
(gnus-group-set-parameter qualgroup 'folder groupname))
|
|
|
|
|
t)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(deffoo nnmairix-retrieve-headers (articles group &optional server fetch-old)
|
|
|
|
|
(when server (nnmairix-open-server server))
|
|
|
|
|
(let* ((folder (nnmairix-get-backend-folder group server))
|
|
|
|
|
(corr (nnmairix-get-numcorr group server))
|
|
|
|
|
(numcorr 0)
|
|
|
|
|
rval)
|
|
|
|
|
(when (and corr
|
|
|
|
|
(not (zerop (cadr corr)))
|
|
|
|
|
(numberp (car articles)))
|
|
|
|
|
(setq numcorr (cadr corr))
|
|
|
|
|
(setq articles
|
|
|
|
|
(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)))
|
|
|
|
|
|
|
|
|
|
(deffoo nnmairix-request-article (article &optional group server to-buffer)
|
|
|
|
|
(when server (nnmairix-open-server server))
|
|
|
|
|
(let ((folder (nnmairix-get-backend-folder group server))
|
|
|
|
|
(corr (nnmairix-get-numcorr group server)))
|
|
|
|
|
(when (and
|
|
|
|
|
(numberp article)
|
|
|
|
|
corr
|
|
|
|
|
(not (zerop (cadr corr))))
|
|
|
|
|
(setq article (- article (cadr corr))))
|
|
|
|
|
(nnmairix-call-backend
|
|
|
|
|
"request-article" article folder nnmairix-backend-server to-buffer))
|
|
|
|
|
t)
|
|
|
|
|
|
|
|
|
|
(deffoo nnmairix-close-group (group &optional server)
|
|
|
|
|
;; Should we do something here?
|
|
|
|
|
nil)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(deffoo nnmairix-request-list (&optional 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)
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(setq cpoint (point))
|
|
|
|
|
(while (re-search-forward nnmairix-group-regexp (point-max) t)
|
|
|
|
|
(setq cur (match-string 1)
|
|
|
|
|
qualgroup (gnus-group-prefixed-name cur
|
|
|
|
|
(list 'nnmairix server)))
|
|
|
|
|
(if (and (gnus-group-entry qualgroup)
|
|
|
|
|
(string= (match-string 0)
|
|
|
|
|
(gnus-group-get-parameter qualgroup 'folder)))
|
|
|
|
|
(progn
|
|
|
|
|
(replace-match cur)
|
|
|
|
|
(delete-region cpoint (point-at-bol))
|
|
|
|
|
(forward-line)
|
|
|
|
|
(setq cpoint (point)))
|
|
|
|
|
(forward-line)))
|
|
|
|
|
(delete-region cpoint (point-max)))
|
|
|
|
|
t)
|
|
|
|
|
nil))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(nnoo-define-skeleton nnmairix)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; === Interactive functions
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-create-search-group (server group query threads)
|
|
|
|
|
"Create on SERVER nnmairix search group GROUP with QUERY.
|
|
|
|
|
If THREADS is t, include whole threads from found messages. If
|
|
|
|
|
called interactively, user will be asked for parameters."
|
|
|
|
|
(interactive
|
|
|
|
|
(list
|
|
|
|
|
(gnus-server-to-method (car (nnmairix-get-server)))
|
|
|
|
|
(read-string "Group name: ")
|
|
|
|
|
(read-string "Query: ")
|
|
|
|
|
(y-or-n-p "Include threads? ")))
|
|
|
|
|
(when (and (stringp query)
|
|
|
|
|
(string-match "\\s-" query))
|
|
|
|
|
(setq query (split-string query)))
|
|
|
|
|
(when (not (listp query))
|
|
|
|
|
(setq query (list query)))
|
|
|
|
|
(when (and server group query)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(let ((groupname (gnus-group-prefixed-name group server))
|
|
|
|
|
info)
|
|
|
|
|
(set-buffer gnus-group-buffer)
|
|
|
|
|
(gnus-group-make-group group server)
|
|
|
|
|
(gnus-group-set-parameter groupname 'query query)
|
|
|
|
|
(gnus-group-set-parameter groupname 'threads threads)
|
|
|
|
|
(nnmairix-update-and-clear-marks groupname)))))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-search-interactive ()
|
|
|
|
|
"Create mairix search interactively with the minibuffer."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let ((char-header nnmairix-interactive-query-parameters)
|
|
|
|
|
header finished query achar)
|
|
|
|
|
(while (not finished)
|
|
|
|
|
(while (not achar)
|
|
|
|
|
(message "Query (%s): " (nnmairix-create-message-line-for-search))
|
|
|
|
|
(setq achar (read-char))
|
|
|
|
|
(when (not (assoc achar char-header))
|
|
|
|
|
(setq achar nil)))
|
|
|
|
|
(setq header (read-string
|
|
|
|
|
(concat "Match " (nth 3 (assoc achar char-header)) " on: ")))
|
|
|
|
|
(push (concat (nth 2 (assoc achar char-header)) ":" header) query)
|
|
|
|
|
(setq finished (not (y-or-n-p "Add another search query? "))
|
|
|
|
|
achar nil))
|
|
|
|
|
(nnmairix-search
|
|
|
|
|
(mapconcat 'identity query " ")
|
|
|
|
|
(car (nnmairix-get-server))
|
|
|
|
|
(y-or-n-p "Include whole threads? "))))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-create-search-group-from-message ()
|
|
|
|
|
"Interactively create search group with query based on current message."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let ((char-header nnmairix-interactive-query-parameters)
|
|
|
|
|
(server (nnmairix-backend-to-server gnus-current-select-method))
|
|
|
|
|
query achar header finished group threads cq)
|
|
|
|
|
(when (or (not (gnus-buffer-live-p gnus-article-buffer))
|
|
|
|
|
(not (gnus-buffer-live-p gnus-summary-buffer)))
|
|
|
|
|
(error "No article or summary buffer"))
|
|
|
|
|
(when (not server)
|
|
|
|
|
(error "No nnmairix server found for back end %s:%s"
|
|
|
|
|
(symbol-name (car gnus-current-select-method))
|
|
|
|
|
(nth 1 gnus-current-select-method)))
|
|
|
|
|
(while (not finished)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(gnus-summary-toggle-header 1)
|
|
|
|
|
(while (not achar)
|
|
|
|
|
(message "Query (%s): " (nnmairix-create-message-line-for-search))
|
|
|
|
|
(setq achar (read-char))
|
|
|
|
|
(when (not (assoc achar char-header))
|
|
|
|
|
(setq achar nil)))
|
|
|
|
|
(set-buffer gnus-article-buffer)
|
|
|
|
|
(setq header nil)
|
|
|
|
|
(when (setq cq (nth 1 (assoc achar char-header)))
|
|
|
|
|
(setq header
|
|
|
|
|
(nnmairix-replace-illegal-chars
|
|
|
|
|
(gnus-fetch-field (nth 1 (assoc achar char-header))))))
|
|
|
|
|
(setq header (read-string
|
|
|
|
|
(concat "Match " (nth 3 (assoc achar char-header)) " on: ")
|
|
|
|
|
header))
|
|
|
|
|
(push (concat (nth 2 (assoc achar char-header)) ":" header) query)
|
|
|
|
|
(setq finished (not (y-or-n-p "Add another search query? "))
|
|
|
|
|
achar nil)))
|
|
|
|
|
(setq threads (y-or-n-p "Include whole threads? "))
|
|
|
|
|
(setq group (read-string "Group name: "))
|
|
|
|
|
(set-buffer gnus-summary-buffer)
|
|
|
|
|
(message "Creating group %s on server %s with query %s." group
|
|
|
|
|
(gnus-method-to-server server) (mapconcat 'identity query " "))
|
|
|
|
|
(nnmairix-create-search-group server group query threads)))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-create-server-and-default-group ()
|
|
|
|
|
"Interactively create new nnmairix server with default search 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)))
|
|
|
|
|
(mairix (read-string "Command to call mairix: " "mairix"))
|
|
|
|
|
(defaultgroup (read-string "Default search group: "))
|
|
|
|
|
(backend (symbol-name (car (gnus-server-to-method server))))
|
|
|
|
|
(servername (nth 1 (gnus-server-to-method server)))
|
|
|
|
|
(hidden (and (string-match "^nn\\(imap\\|maildir\\)$" backend)
|
|
|
|
|
(y-or-n-p
|
|
|
|
|
"Does the back end server work with maildir++ (i.e. hidden directories)? ")))
|
|
|
|
|
create)
|
|
|
|
|
|
|
|
|
|
(apply (intern (format "%s-%s" backend "open-server"))
|
|
|
|
|
(list servername))
|
|
|
|
|
|
|
|
|
|
(when (and hidden
|
|
|
|
|
(string-match "^\\." defaultgroup))
|
|
|
|
|
(setq defaultgroup (substring defaultgroup 1)))
|
|
|
|
|
;; Create default search group
|
|
|
|
|
(gnus-group-make-group
|
|
|
|
|
defaultgroup (list 'nnmairix name (list 'nnmairix-backend (intern backend))
|
|
|
|
|
(list 'nnmairix-backend-server servername)
|
|
|
|
|
(list 'nnmairix-mairix-command mairix)
|
|
|
|
|
(list 'nnmairix-hidden-folders hidden)
|
|
|
|
|
(list 'nnmairix-default-group defaultgroup)))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-group-change-query-this-group (&optional query)
|
|
|
|
|
"Set QUERY for group under cursor."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let* ((group (gnus-group-group-name))
|
|
|
|
|
(method (gnus-find-method-for-group group))
|
|
|
|
|
(oldquery (gnus-group-get-parameter group 'query t)))
|
|
|
|
|
(if (eq (car method) 'nnmairix)
|
|
|
|
|
(progn
|
|
|
|
|
(when (listp oldquery)
|
|
|
|
|
(setq oldquery (mapconcat 'identity oldquery " ")))
|
|
|
|
|
(setq query (or query
|
|
|
|
|
(read-string "New query: " oldquery)))
|
|
|
|
|
(when (stringp query)
|
|
|
|
|
(setq query (split-string query)))
|
|
|
|
|
(when query
|
|
|
|
|
(gnus-group-set-parameter group 'query query)
|
|
|
|
|
(nnmairix-update-and-clear-marks group)))
|
|
|
|
|
(error "This is no nnmairix group"))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-group-toggle-threads-this-group (&optional threads)
|
|
|
|
|
"Toggle threads parameter for this group.
|
|
|
|
|
If THREADS is a positive number, set threads parameter to t.
|
|
|
|
|
If THREADS is a negative number, set it to nil."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let* ((group (gnus-group-group-name))
|
|
|
|
|
(method (gnus-find-method-for-group group))
|
|
|
|
|
(getthreads (or threads
|
|
|
|
|
(not (gnus-group-get-parameter group 'threads)))))
|
|
|
|
|
(if (eq (car method) 'nnmairix)
|
|
|
|
|
(progn
|
|
|
|
|
(when (numberp getthreads)
|
|
|
|
|
(setq getthreads (> getthreads 0)))
|
|
|
|
|
(gnus-group-set-parameter group 'threads getthreads)
|
|
|
|
|
(if getthreads
|
|
|
|
|
(message "Threads activated for group %s" group)
|
|
|
|
|
(message "Threads deacitavted for group %s" group))
|
|
|
|
|
(nnmairix-update-and-clear-marks group))
|
|
|
|
|
(error "This is no nnmairix group"))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-search (query &optional server threads)
|
|
|
|
|
"Sends QUERY to nnmairix backend SERVER, using default its search group.
|
|
|
|
|
|
|
|
|
|
Default search group is automatically entered and results are shown.
|
|
|
|
|
If THREADS is t, enable threads.
|
|
|
|
|
If THREADS is a negative number, disable threads.
|
|
|
|
|
Otherwise, leave threads parameter as it is."
|
|
|
|
|
(interactive (list (read-string "Query: ")))
|
|
|
|
|
(when (not server)
|
|
|
|
|
(setq server (car (nnmairix-get-server))))
|
|
|
|
|
(if (not server)
|
|
|
|
|
(error "No opened nnmairix server found")
|
|
|
|
|
(setq server (gnus-server-to-method server)))
|
|
|
|
|
(nnmairix-open-server (nth 1 server))
|
|
|
|
|
(let* ((qualgroup (gnus-group-prefixed-name nnmairix-default-group
|
|
|
|
|
(list 'nnmairix (nth 1 server)))))
|
|
|
|
|
(set-buffer gnus-group-buffer)
|
|
|
|
|
(when (stringp query)
|
|
|
|
|
(setq query (split-string query)))
|
|
|
|
|
(gnus-group-set-parameter qualgroup 'query query)
|
|
|
|
|
(if (symbolp threads)
|
|
|
|
|
(when (eq threads 't)
|
|
|
|
|
(gnus-group-set-parameter qualgroup 'threads t))
|
|
|
|
|
(when (< threads 0)
|
|
|
|
|
(gnus-group-set-parameter qualgroup 'threads nil)))
|
|
|
|
|
(nnmairix-update-and-clear-marks qualgroup)
|
|
|
|
|
(when (not (zerop (gnus-group-unread qualgroup)))
|
|
|
|
|
(gnus-group-read-group nil t qualgroup))))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-search-thread-this-article ()
|
|
|
|
|
"Search thread for the current article.
|
|
|
|
|
This is effectively a shortcut for calling `nnmairix-search'
|
|
|
|
|
with m:msgid of the current article and enabled threads."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let* ((server
|
|
|
|
|
(nnmairix-backend-to-server gnus-current-select-method))
|
|
|
|
|
mid)
|
|
|
|
|
(if server
|
|
|
|
|
(if (gnus-buffer-live-p gnus-article-buffer)
|
|
|
|
|
(progn
|
|
|
|
|
(save-excursion
|
|
|
|
|
(set-buffer gnus-article-buffer)
|
|
|
|
|
(gnus-summary-toggle-header 1)
|
|
|
|
|
(setq mid (message-fetch-field "Message-ID")))
|
|
|
|
|
(while (string-match "[<>]" mid)
|
|
|
|
|
(setq mid (replace-match "" t t mid)))
|
|
|
|
|
(nnmairix-search (concat "m:" mid) server t))
|
|
|
|
|
(message "No article buffer."))
|
|
|
|
|
(error "No nnmairix server found for back end %s:%s"
|
|
|
|
|
(symbol-name (car gnus-current-select-method))
|
|
|
|
|
(nth 1 gnus-current-select-method)))))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-search-from-this-article ()
|
|
|
|
|
"Search messages from sender of the current article.
|
|
|
|
|
This is effectively a shortcut for calling `nnmairix-search' with
|
|
|
|
|
f:current_from."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let* ((server
|
|
|
|
|
(nnmairix-backend-to-server gnus-current-select-method))
|
|
|
|
|
from)
|
|
|
|
|
(if server
|
|
|
|
|
(if (gnus-buffer-live-p gnus-article-buffer)
|
|
|
|
|
(progn
|
|
|
|
|
(save-excursion
|
|
|
|
|
(set-buffer gnus-article-buffer)
|
|
|
|
|
(gnus-summary-toggle-header 1)
|
|
|
|
|
(setq from (cadr (gnus-extract-address-components
|
|
|
|
|
(gnus-fetch-field "From"))))
|
|
|
|
|
(nnmairix-search (concat "f:" from) server -1)))
|
|
|
|
|
(message "No article buffer."))
|
|
|
|
|
(error "No nnmairix server found for back end %s:%s"
|
|
|
|
|
(symbol-name (car gnus-current-select-method))
|
|
|
|
|
(nth 1 gnus-current-select-method)))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-purge-old-groups (&optional dontask server)
|
|
|
|
|
"Delete mairix search groups which are no longer used.
|
|
|
|
|
|
|
|
|
|
You may want to call this from time to time if you are creating
|
|
|
|
|
and deleting lots of nnmairix groups. If DONTASK is t, do not ask
|
|
|
|
|
before deleting a group on the back end. SERVER specifies nnmairix server."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let ((server (or server
|
|
|
|
|
(gnus-server-to-method (car (nnmairix-get-server))))))
|
|
|
|
|
(if (nnmairix-open-server (nth 1 server))
|
|
|
|
|
(when (nnmairix-call-backend
|
|
|
|
|
"request-list" nnmairix-backend-server)
|
|
|
|
|
(let (cur qualgroup folder)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(set-buffer nntp-server-buffer)
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(while (re-search-forward nnmairix-group-regexp (point-max) t)
|
|
|
|
|
(setq cur (match-string 0)
|
|
|
|
|
qualgroup (gnus-group-prefixed-name
|
|
|
|
|
(match-string 1) server))
|
|
|
|
|
(when (not (and (gnus-group-entry qualgroup)
|
|
|
|
|
(string= cur
|
|
|
|
|
(gnus-group-get-parameter
|
|
|
|
|
qualgroup 'folder))))
|
|
|
|
|
(when (or dontask
|
|
|
|
|
(y-or-n-p
|
|
|
|
|
(concat "Delete group " cur
|
|
|
|
|
" on server " nnmairix-backend-server "? ")))
|
|
|
|
|
(nnmairix-call-backend
|
|
|
|
|
"request-delete-group" cur t nnmairix-backend-server)))))))
|
|
|
|
|
(message "Couldn't open server %s" (nth 1 server)))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-update-database (&optional servers)
|
|
|
|
|
"Call mairix for updating the database for SERVERS.
|
|
|
|
|
|
|
|
|
|
If SERVERS is nil, do update for all nnmairix servers. Mairix
|
|
|
|
|
will be called asynchronously unless
|
|
|
|
|
`nnmairix-mairix-synchronous-update' is t. Mairix will be called
|
|
|
|
|
with `nnmairix-mairix-update-options'."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let ((servers (or servers
|
|
|
|
|
(nnmairix-get-nnmairix-servers)))
|
|
|
|
|
args cur commandsplit)
|
|
|
|
|
(while servers
|
|
|
|
|
(setq cur (car (pop servers)))
|
|
|
|
|
(nnmairix-open-server
|
|
|
|
|
(nth 1 (gnus-server-to-method cur)))
|
|
|
|
|
(setq commandsplit (split-string nnmairix-mairix-command))
|
|
|
|
|
(nnheader-message 7 "Updating mairix database for %s..." cur)
|
|
|
|
|
(if nnmairix-mairix-synchronous-update
|
|
|
|
|
(progn
|
|
|
|
|
(setq args (append (list (car commandsplit) nil
|
|
|
|
|
(get-buffer nnmairix-mairix-output-buffer)
|
|
|
|
|
nil)))
|
|
|
|
|
(if (> (length commandsplit) 1)
|
|
|
|
|
(setq args (append args (cdr commandsplit) nnmairix-mairix-update-options))
|
|
|
|
|
(setq args (append args nnmairix-mairix-update-options)))
|
|
|
|
|
(apply 'call-process args)
|
|
|
|
|
(nnheader-message 7 "Updating mairix database for %s... done" cur))
|
|
|
|
|
(progn
|
|
|
|
|
(setq args (append (list cur (get-buffer nnmairix-mairix-output-buffer)
|
|
|
|
|
(car commandsplit))))
|
|
|
|
|
(if (> (length commandsplit) 1)
|
|
|
|
|
(setq args (append args (cdr commandsplit) nnmairix-mairix-update-options))
|
|
|
|
|
(setq args (append args nnmairix-mairix-update-options)))
|
|
|
|
|
(set-process-sentinel (apply 'start-process args)
|
|
|
|
|
'nnmairix-sentinel-mairix-update-finished))))))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-goto-original-article (&optional no-registry)
|
|
|
|
|
"Jump to the original group and display article.
|
|
|
|
|
The original group of the article is first determined with the
|
|
|
|
|
registry (if enabled). If the registry is not enabled or did not
|
|
|
|
|
find the article or the prefix NO-REGISTRY is non-nil, this
|
|
|
|
|
function will try to determine the original group form the path
|
|
|
|
|
of the mail file. The path is obtained through another mairix
|
|
|
|
|
search in raw mode."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(when (not (eq (car gnus-current-select-method) 'nnmairix))
|
|
|
|
|
(let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
|
|
|
|
|
(if (eq (car method) 'nnmairix)
|
|
|
|
|
(nnmairix-open-server (nth 1 method))
|
|
|
|
|
(error "Not in a nnmairix group"))))
|
|
|
|
|
(when (not (gnus-buffer-live-p gnus-article-buffer))
|
|
|
|
|
(error "No article buffer available"))
|
|
|
|
|
(let ((server (nth 1 gnus-current-select-method))
|
|
|
|
|
mid rval group allgroups)
|
|
|
|
|
;; get message id
|
|
|
|
|
(save-excursion
|
|
|
|
|
(set-buffer gnus-article-buffer)
|
|
|
|
|
(gnus-summary-toggle-header 1)
|
|
|
|
|
(setq mid (message-fetch-field "Message-ID"))
|
|
|
|
|
;; first check the registry (if available)
|
|
|
|
|
(when (and (boundp 'gnus-registry-install)
|
|
|
|
|
gnus-registry-install
|
|
|
|
|
(not no-registry))
|
|
|
|
|
(setq group (gnus-registry-fetch-group mid)))
|
|
|
|
|
(while (string-match "[<>]" mid)
|
|
|
|
|
(setq mid (replace-match "" t t mid)))
|
|
|
|
|
(unless group
|
|
|
|
|
;; registry was not available or did not find article
|
|
|
|
|
;; so we search again with mairix in raw mode to get filename
|
|
|
|
|
(nnmairix-open-server server)
|
|
|
|
|
(setq rval
|
|
|
|
|
(nnmairix-call-mairix-binary-raw
|
|
|
|
|
(split-string nnmairix-mairix-command)
|
|
|
|
|
(list (concat "m:" mid))))
|
|
|
|
|
(if (zerop rval)
|
|
|
|
|
;; determine original group(s) from filename
|
|
|
|
|
(save-excursion
|
|
|
|
|
(set-buffer nnmairix-mairix-output-buffer)
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(while (looking-at "/")
|
|
|
|
|
(push (nnmairix-determine-original-group)
|
|
|
|
|
allgroups)
|
|
|
|
|
(forward-line 1))
|
|
|
|
|
(if (> (length allgroups) 1)
|
|
|
|
|
(setq group
|
|
|
|
|
(completing-read
|
|
|
|
|
"Message exists in more than one group. Choose: "
|
|
|
|
|
allgroups nil t))
|
|
|
|
|
(setq group (car allgroups))))
|
|
|
|
|
(error "Mairix could not find original article. See buffer %s for details"
|
|
|
|
|
nnmairix-mairix-output-buffer))))
|
|
|
|
|
(if group
|
|
|
|
|
;; show article in summary buffer
|
|
|
|
|
(nnmairix-show-original-article group mid)
|
|
|
|
|
(message "Couldn't find original article"))))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-determine-original-group ()
|
|
|
|
|
"Try to determine to original group from the file path."
|
|
|
|
|
(let (path filename serverbase group maildirflag allgroups)
|
|
|
|
|
(re-search-forward "^\\(.*\\)/\\(.*?\\)$")
|
|
|
|
|
(setq path (expand-file-name (match-string 1)))
|
|
|
|
|
(setq filename (match-string 2))
|
|
|
|
|
;; when we deal with maildir, remove cur/new/tmp from path
|
|
|
|
|
(setq maildirflag (string-match ".+\\..+\\..+" filename))
|
|
|
|
|
(when maildirflag
|
|
|
|
|
(setq path
|
|
|
|
|
(replace-regexp-in-string
|
|
|
|
|
".*\\(/cur\\|/new\\|/tmp\\)$" "" path t t 1)))
|
|
|
|
|
;; we first check nnml and nnmaildir servers
|
|
|
|
|
(setq
|
|
|
|
|
group
|
|
|
|
|
(catch 'found
|
|
|
|
|
(dolist (cur gnus-opened-servers)
|
|
|
|
|
(when (or (and (not maildirflag)
|
|
|
|
|
(eq (caar cur) 'nnml))
|
|
|
|
|
(and maildirflag
|
|
|
|
|
(eq (caar cur) 'nnmaildir)))
|
|
|
|
|
;; get base path from server
|
|
|
|
|
(if maildirflag
|
|
|
|
|
(setq serverbase (cadr (assoc 'directory (car cur))))
|
|
|
|
|
(setq serverbase (cadr (assoc 'nnml-directory (car cur))))
|
|
|
|
|
(when (not serverbase)
|
|
|
|
|
(setq serverbase nnml-directory)))
|
|
|
|
|
(setq serverbase (file-name-as-directory
|
|
|
|
|
(expand-file-name serverbase)))
|
|
|
|
|
(when (string-match (concat serverbase "\\(.*\\)") path)
|
|
|
|
|
;; looks good - rest of the path should be the group
|
|
|
|
|
(setq group (match-string 1 path))
|
|
|
|
|
(when (string-match "/$" group)
|
|
|
|
|
(setq group (replace-match "" t t group)))
|
|
|
|
|
(when (not maildirflag)
|
|
|
|
|
;; for nnml: convert slashes to dots
|
|
|
|
|
(while (string-match "/" group)
|
|
|
|
|
(setq group (replace-match "." t t group))))
|
|
|
|
|
(setq group (gnus-group-prefixed-name group (car cur)))
|
|
|
|
|
;; check whether this group actually exists
|
|
|
|
|
(when (gnus-group-entry group)
|
|
|
|
|
(throw 'found group)))))))
|
|
|
|
|
(unless group
|
|
|
|
|
;; we haven't found it yet --> look for nnimap groups
|
|
|
|
|
;; assume last element of the path is the group
|
|
|
|
|
(string-match "^.*/\\.?\\(.*\\)$" path)
|
|
|
|
|
(setq group (match-string 1 path))
|
|
|
|
|
;; convert dots to slashes (nested group)
|
|
|
|
|
(while (string-match "\\." group)
|
|
|
|
|
(setq group (replace-match "/" t t group)))
|
|
|
|
|
(dolist (cur gnus-opened-servers)
|
|
|
|
|
(when (eq (caar cur) 'nnimap)
|
|
|
|
|
(when (gnus-group-entry
|
|
|
|
|
(gnus-group-prefixed-name group (car cur)))
|
|
|
|
|
(push
|
|
|
|
|
(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 (car allgroups))))
|
|
|
|
|
group))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; ==== Helper functions
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-request-group-with-article-number-correction (folder qualgroup)
|
|
|
|
|
"Request FOLDER on backend for nnmairix QUALGROUP and article number correction."
|
|
|
|
|
(save-excursion
|
|
|
|
|
(nnmairix-call-backend
|
|
|
|
|
"request-group" folder nnmairix-backend-server fast)
|
|
|
|
|
(set-buffer nnmairix-mairix-output-buffer)
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(re-search-forward "^Matched.*messages")
|
|
|
|
|
(nnheader-message 7 (match-string 0))
|
|
|
|
|
(set-buffer nntp-server-buffer)
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(let ((status (read (current-buffer)))
|
|
|
|
|
(total (read (current-buffer)))
|
|
|
|
|
(low (read (current-buffer)))
|
|
|
|
|
(high (read (current-buffer)))
|
|
|
|
|
(corr (gnus-group-get-parameter qualgroup 'numcorr t)))
|
|
|
|
|
(if (= status 211)
|
|
|
|
|
(progn
|
|
|
|
|
;; Article number correction
|
|
|
|
|
(if (and corr
|
|
|
|
|
(> (+ (car (cddr corr)) high) 0))
|
|
|
|
|
(progn
|
|
|
|
|
(when (car corr) ;Group has changed
|
|
|
|
|
(setq corr
|
|
|
|
|
(list nil
|
|
|
|
|
(car (cddr corr))
|
|
|
|
|
(+ (car (cddr corr)) high)))
|
|
|
|
|
(gnus-group-set-parameter
|
|
|
|
|
qualgroup 'numcorr corr))
|
|
|
|
|
(setq low (+ low (cadr corr))
|
|
|
|
|
high (+ high (cadr corr))))
|
|
|
|
|
(when (member nnmairix-backend
|
|
|
|
|
nnmairix-delete-and-create-on-change)
|
|
|
|
|
(gnus-group-set-parameter
|
|
|
|
|
qualgroup 'numcorr (list nil 0 high))))
|
|
|
|
|
(erase-buffer)
|
|
|
|
|
(insert (format "%d %d %d %d %s" status total low high group))
|
|
|
|
|
t)
|
|
|
|
|
(progn
|
|
|
|
|
(nnheader-report
|
|
|
|
|
'nnmairix "Error calling back end on group %s" folder)
|
|
|
|
|
nil)))))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-call-mairix-binary (command folder query threads)
|
|
|
|
|
"Call mairix binary with COMMAND, using FOLDER and QUERY.
|
|
|
|
|
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))
|
|
|
|
|
(erase-buffer)
|
|
|
|
|
(when (> (length command) 1)
|
|
|
|
|
(setq args (append args (cdr command))))
|
|
|
|
|
(when threads
|
|
|
|
|
(setq args (append args '("-t"))))
|
|
|
|
|
(apply 'call-process
|
|
|
|
|
(append args (list "-o" folder) query)))))
|
|
|
|
|
|
|
|
|
|
(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))
|
|
|
|
|
(erase-buffer)
|
|
|
|
|
(when (> (length command) 1)
|
|
|
|
|
(setq args (append args (cdr command))))
|
|
|
|
|
(setq args (append args '("-r")))
|
|
|
|
|
(apply 'call-process
|
|
|
|
|
(append args query)))))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-get-server ()
|
|
|
|
|
"If there exists just one nnmairix server, return its value.
|
|
|
|
|
Otherwise, ask user for server."
|
|
|
|
|
(let ((openedserver (nnmairix-get-nnmairix-servers)))
|
|
|
|
|
(when (not openedserver)
|
|
|
|
|
(error "No opened nnmairix server found"))
|
|
|
|
|
(if (> (length openedserver) 1)
|
|
|
|
|
(progn
|
|
|
|
|
(while
|
|
|
|
|
(equal '("")
|
|
|
|
|
(setq nnmairix-last-server
|
|
|
|
|
(list (completing-read "Server: " openedserver nil 1
|
|
|
|
|
(or nnmairix-last-server
|
|
|
|
|
"nnmairix:"))))))
|
|
|
|
|
nnmairix-last-server)
|
|
|
|
|
(car openedserver))))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-get-nnmairix-servers (&optional all)
|
|
|
|
|
"Return available nnmairix servers.
|
|
|
|
|
If ALL is t, return also the unopened/failed ones."
|
|
|
|
|
(let ((alist gnus-opened-servers)
|
|
|
|
|
server openedserver)
|
|
|
|
|
(while alist
|
|
|
|
|
(setq server (pop alist))
|
|
|
|
|
(when (and server
|
|
|
|
|
(or all
|
|
|
|
|
(eq (cadr server) 'ok))
|
|
|
|
|
(eq (caar server) 'nnmairix)
|
|
|
|
|
(not (member (car server) gnus-ephemeral-servers)))
|
|
|
|
|
(setq server
|
|
|
|
|
(concat (symbol-name (caar server)) ":" (nth 1 (car server))))
|
|
|
|
|
(push (list server) openedserver)))
|
|
|
|
|
openedserver))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-get-valid-servers ()
|
|
|
|
|
"Return list of valid backend servers for nnmairix groups."
|
|
|
|
|
(let ((alist gnus-opened-servers)
|
|
|
|
|
(mairixservers (nnmairix-get-nnmairix-servers t))
|
|
|
|
|
server mserver openedserver occ cur)
|
|
|
|
|
;; Get list of all nnmairix backends (i.e. backends which are
|
|
|
|
|
;; already occupied)
|
|
|
|
|
(dolist (cur mairixservers)
|
|
|
|
|
(push
|
|
|
|
|
(concat
|
|
|
|
|
(symbol-name
|
|
|
|
|
(cadr (assoc 'nnmairix-backend
|
|
|
|
|
(gnus-server-to-method (car cur)))))
|
|
|
|
|
":"
|
|
|
|
|
(cadr (assoc 'nnmairix-backend-server
|
|
|
|
|
(gnus-server-to-method (car cur)))))
|
|
|
|
|
occ))
|
|
|
|
|
(while alist
|
|
|
|
|
(setq server (pop alist))
|
|
|
|
|
(setq mserver (gnus-method-to-server (car server)))
|
|
|
|
|
;; If this is the native server, convert it to the real server
|
|
|
|
|
;; name to avoid confusion
|
|
|
|
|
(when (string= mserver "native")
|
|
|
|
|
(setq mserver (format "%s:%s"
|
|
|
|
|
(caar server)
|
|
|
|
|
(nth 1 (car server)))))
|
|
|
|
|
(when (and server
|
|
|
|
|
(eq (cadr server) 'ok)
|
|
|
|
|
(member (caar server) nnmairix-valid-backends)
|
|
|
|
|
(not (member (car server) gnus-ephemeral-servers))
|
|
|
|
|
(not (member (gnus-method-to-server (car server)) occ)))
|
|
|
|
|
(push
|
|
|
|
|
(list mserver)
|
|
|
|
|
openedserver)))
|
|
|
|
|
openedserver))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-call-backend (func &rest args)
|
|
|
|
|
"Call a function FUNC on backend with ARGS."
|
|
|
|
|
(apply (intern (format "%s-%s" (symbol-name nnmairix-backend) func)) args))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-get-backend-folder (group &optional server)
|
|
|
|
|
"Return back end GROUP from nnmairix group on SERVER."
|
|
|
|
|
(let* ((qualgroup (if server
|
|
|
|
|
(gnus-group-prefixed-name group (list 'nnmairix server))
|
|
|
|
|
group))
|
|
|
|
|
(folder (gnus-group-get-parameter qualgroup 'folder)))
|
|
|
|
|
folder))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-get-numcorr (group &optional server)
|
|
|
|
|
"Return values for article number correction nnmairix GROUP on SERVER."
|
|
|
|
|
(let* ((qualgroup (if server
|
|
|
|
|
(gnus-group-prefixed-name group (list 'nnmairix server))
|
|
|
|
|
group))
|
|
|
|
|
(corr (gnus-group-get-parameter qualgroup 'numcorr t)))
|
|
|
|
|
corr))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-rename-files-consecutively (path)
|
|
|
|
|
"Rename all nnml mail files in PATH so that they have consecutive numbers.
|
|
|
|
|
This should correct problems of wrong article counts when using
|
|
|
|
|
nnmairix with nnml backends."
|
|
|
|
|
(let* ((files
|
|
|
|
|
(sort
|
|
|
|
|
(mapcar 'string-to-number
|
|
|
|
|
(directory-files path nil "[0-9]+" t))
|
|
|
|
|
'<))
|
|
|
|
|
(lastplusone (car files))
|
|
|
|
|
(path (file-name-as-directory path)))
|
|
|
|
|
(dolist (cur files)
|
|
|
|
|
(when (not (= cur lastplusone))
|
|
|
|
|
(rename-file (concat path
|
|
|
|
|
(number-to-string cur))
|
|
|
|
|
(concat path
|
|
|
|
|
(number-to-string lastplusone)))
|
|
|
|
|
(setq cur lastplusone))
|
|
|
|
|
(setq lastplusone (1+ cur)))))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-replace-group-and-numbers (articles backendgroup mairixgroup numc)
|
|
|
|
|
"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...")
|
|
|
|
|
(mapcar
|
|
|
|
|
(function
|
|
|
|
|
(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))))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-backend-to-server (server)
|
|
|
|
|
"Return nnmairix server most probably responsible for back end SERVER.
|
|
|
|
|
User will be asked if this cannot be determined. Result is saved in
|
|
|
|
|
parameter 'indexed-servers of corresponding default search
|
|
|
|
|
group."
|
|
|
|
|
(let ((allservers (nnmairix-get-nnmairix-servers))
|
|
|
|
|
mairixserver found defaultgroup)
|
|
|
|
|
(if (> (length allservers) 1)
|
|
|
|
|
(progn
|
|
|
|
|
;; If there is more than one nnmairix server, we go through them
|
|
|
|
|
(while (and allservers (not found))
|
|
|
|
|
(setq mairixserver (gnus-server-to-method (car (pop allservers))))
|
|
|
|
|
;; First we look if SERVER is the backend of current nnmairix server
|
|
|
|
|
(setq found (and (eq (cadr (assoc 'nnmairix-backend mairixserver))
|
|
|
|
|
(car server))
|
|
|
|
|
(string= (cadr (assoc 'nnmairix-backend-server mairixserver))
|
|
|
|
|
(nth 1 server))))
|
|
|
|
|
;; If that's not the case, we look at 'indexed-servers
|
|
|
|
|
;; variable in default search group
|
|
|
|
|
(when (not found)
|
|
|
|
|
(setq defaultgroup (cadr (assoc 'nnmairix-default-group mairixserver)))
|
|
|
|
|
(setq found (member (gnus-method-to-server server)
|
|
|
|
|
(gnus-group-get-parameter
|
|
|
|
|
(gnus-group-prefixed-name defaultgroup
|
|
|
|
|
mairixserver)
|
|
|
|
|
'indexed-servers t)))))
|
|
|
|
|
;; If still not found, we ask user
|
|
|
|
|
(when (not found)
|
|
|
|
|
(setq mairixserver
|
|
|
|
|
(gnus-server-to-method
|
|
|
|
|
(completing-read
|
|
|
|
|
(format "Cannot determine which nnmairix server indexes %s. Please specify: "
|
|
|
|
|
(gnus-method-to-server server))
|
|
|
|
|
(nnmairix-get-nnmairix-servers) nil 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
|
|
|
|
|
(cadr (assoc 'nnmairix-default-group mairixserver)) mairixserver))
|
|
|
|
|
(gnus-group-set-parameter
|
|
|
|
|
defaultgroup
|
|
|
|
|
'indexed-servers
|
|
|
|
|
(append (gnus-group-get-parameter defaultgroup 'indexed-servers t)
|
|
|
|
|
(list (gnus-method-to-server server)))))
|
|
|
|
|
mairixserver)
|
|
|
|
|
;; If there is just one (or none) nnmairix server:
|
|
|
|
|
(gnus-server-to-method (caar allservers)))))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-update-and-clear-marks (group &optional method)
|
|
|
|
|
"Update group and clear all marks from GROUP using METHOD."
|
|
|
|
|
(when method
|
|
|
|
|
(setq group (gnus-group-prefixed-name group method)))
|
|
|
|
|
(let ((method (or method
|
|
|
|
|
(gnus-find-method-for-group group)))
|
|
|
|
|
(folder (gnus-group-get-parameter group 'folder))
|
|
|
|
|
(corr (gnus-group-get-parameter group 'numcorr t))
|
|
|
|
|
info)
|
|
|
|
|
(if (eq (nth 0 method) 'nnmairix)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(nnmairix-open-server (nth 1 method))
|
|
|
|
|
(set-buffer gnus-group-buffer)
|
|
|
|
|
(setq info (gnus-get-info group))
|
|
|
|
|
;; Clear active and info
|
|
|
|
|
(gnus-set-active group nil)
|
|
|
|
|
(gnus-info-clear-data info)
|
|
|
|
|
;; Delete and re-create group if needed
|
|
|
|
|
(when (member nnmairix-backend nnmairix-delete-and-create-on-change)
|
|
|
|
|
(if (string-match nnmairix-group-regexp folder)
|
|
|
|
|
(progn
|
|
|
|
|
(nnmairix-call-backend "open-server"
|
|
|
|
|
nnmairix-backend-server)
|
|
|
|
|
(nnmairix-call-backend "request-delete-group"
|
|
|
|
|
folder t nnmairix-backend-server)
|
|
|
|
|
(nnmairix-call-backend "request-create-group"
|
|
|
|
|
folder nnmairix-backend-server)
|
|
|
|
|
;; set flag that group has changed for article number correction
|
|
|
|
|
(when corr
|
|
|
|
|
(setcar corr t)
|
|
|
|
|
(gnus-group-set-parameter group 'numcorr corr)))
|
|
|
|
|
(error "Nnmairix-update-and-clear-marks - delete/create with\
|
|
|
|
|
non-mairix group!! - check folder parameter")))
|
|
|
|
|
(when (gnus-group-jump-to-group group)
|
|
|
|
|
(gnus-group-get-new-news-this-group)))
|
|
|
|
|
(error "Nnmairix-update-and-clear-marks - Called with non-nnmairix group"))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-sentinel-mairix-update-finished (proc status)
|
|
|
|
|
"Sentinel for mairix update process PROC with STATUS."
|
|
|
|
|
(if (equal status "finished\n")
|
|
|
|
|
(nnheader-message 7 "Updating mairix database for %s... done" proc)
|
|
|
|
|
(error "There was an error updating the mairix database for server %s. \
|
|
|
|
|
See %s for details" proc nnmairix-mairix-output-buffer)))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-create-message-line-for-search ()
|
|
|
|
|
"Create message line for interactive query in minibuffer."
|
|
|
|
|
(mapconcat
|
|
|
|
|
(function
|
|
|
|
|
(lambda (cur)
|
|
|
|
|
(format "%c=%s" (car cur) (nth 3 cur))))
|
|
|
|
|
nnmairix-interactive-query-parameters ","))
|
|
|
|
|
|
|
|
|
|
(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 "[-& ]" header)
|
|
|
|
|
(setq header (replace-match "," t t header)))
|
|
|
|
|
header))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-show-original-article (group mid)
|
|
|
|
|
"Switch to GROUP and display Article with message-id MID."
|
|
|
|
|
(when (string-match "Summary" (buffer-name (current-buffer)))
|
|
|
|
|
(gnus-summary-exit))
|
|
|
|
|
(pop-to-buffer gnus-group-buffer)
|
|
|
|
|
(gnus-group-jump-to-group group)
|
|
|
|
|
(gnus-summary-read-group group 1 t)
|
|
|
|
|
(gnus-summary-refer-article mid)
|
|
|
|
|
(gnus-summary-limit-to-headers (format "message-id: <%s>" mid))
|
|
|
|
|
(gnus-summary-select-article)
|
|
|
|
|
;; Force redisplay
|
|
|
|
|
(gnus-summary-show-article)
|
|
|
|
|
(nnheader-message 5 "Switched to group %s." group))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; ==== Widget stuff
|
|
|
|
|
|
|
|
|
|
(defvar nnmairix-widgets)
|
|
|
|
|
(defvar nnmairix-widgets-values nil)
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-widget-search-from-this-article ()
|
|
|
|
|
"Create mairix query based on current article using graphical widgets."
|
|
|
|
|
(interactive)
|
|
|
|
|
(nnmairix-widget-search
|
|
|
|
|
(nnmairix-widget-get-values)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-widget-get-values ()
|
|
|
|
|
"Create values for editable fields from current article."
|
|
|
|
|
(if (not (gnus-buffer-live-p gnus-article-buffer))
|
|
|
|
|
(error "No article buffer available")
|
|
|
|
|
(save-excursion
|
|
|
|
|
(gnus-summary-toggle-header 1)
|
|
|
|
|
(set-buffer gnus-article-buffer)
|
|
|
|
|
(mapcar
|
|
|
|
|
(function
|
|
|
|
|
(lambda (field)
|
|
|
|
|
(list (caddr field)
|
|
|
|
|
(if (car field)
|
|
|
|
|
(nnmairix-replace-illegal-chars
|
|
|
|
|
(gnus-fetch-field (car field)))
|
|
|
|
|
nil))))
|
|
|
|
|
nnmairix-widget-fields-list))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-widget-search (&optional mvalues)
|
|
|
|
|
"Create mairix query interactively using graphical widgets.
|
|
|
|
|
MVALUES may contain values from current article."
|
|
|
|
|
(interactive)
|
|
|
|
|
;; Select window for mairix customization
|
|
|
|
|
(funcall nnmairix-widget-select-window-function)
|
|
|
|
|
;; generate widgets
|
|
|
|
|
(nnmairix-widget-create-query mvalues)
|
|
|
|
|
;; generate Buttons
|
|
|
|
|
(widget-create 'push-button
|
|
|
|
|
:notify
|
|
|
|
|
(if mvalues
|
|
|
|
|
(lambda (&rest ignore)
|
|
|
|
|
(nnmairix-widget-send-query nnmairix-widgets
|
|
|
|
|
t))
|
|
|
|
|
(lambda (&rest ignore)
|
|
|
|
|
(nnmairix-widget-send-query nnmairix-widgets
|
|
|
|
|
nil)))
|
|
|
|
|
"Send Query")
|
|
|
|
|
(widget-insert " ")
|
|
|
|
|
(widget-create 'push-button
|
|
|
|
|
:notify
|
|
|
|
|
(if mvalues
|
|
|
|
|
(lambda (&rest ignore)
|
|
|
|
|
(nnmairix-widget-create-group nnmairix-widgets
|
|
|
|
|
t))
|
|
|
|
|
(lambda (&rest ignore)
|
|
|
|
|
(nnmairix-widget-create-group nnmairix-widgets
|
|
|
|
|
nil)))
|
|
|
|
|
"Create permanent group")
|
|
|
|
|
(widget-insert " ")
|
|
|
|
|
(widget-create 'push-button
|
|
|
|
|
:notify (lambda (&rest ignore)
|
|
|
|
|
(kill-buffer nnmairix-customize-query-buffer))
|
|
|
|
|
"Cancel")
|
|
|
|
|
(use-local-map widget-keymap)
|
|
|
|
|
(widget-setup)
|
|
|
|
|
(goto-char (point-min)))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-widget-send-query (widgets &optional withvalues)
|
|
|
|
|
"Send query from WIDGETS to mairix binary.
|
|
|
|
|
If WITHVALUES is t, query is based on current article."
|
|
|
|
|
(nnmairix-search
|
|
|
|
|
(nnmairix-widget-make-query-from-widgets widgets)
|
|
|
|
|
(if withvalues
|
|
|
|
|
(gnus-method-to-server
|
|
|
|
|
(nnmairix-backend-to-server gnus-current-select-method))
|
|
|
|
|
(car (nnmairix-get-server)))
|
|
|
|
|
(if (widget-value (cadr (assoc "Threads" widgets)))
|
|
|
|
|
t
|
|
|
|
|
-1))
|
|
|
|
|
(kill-buffer nnmairix-customize-query-buffer))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-widget-create-group (widgets &optional withvalues)
|
|
|
|
|
"Create nnmairix group based on current widget values WIDGETS.
|
|
|
|
|
If WITHVALUES is t, query is based on current article."
|
|
|
|
|
(let ((group (read-string "Name of the group: ")))
|
|
|
|
|
(when (not (zerop (length group)))
|
|
|
|
|
(nnmairix-create-search-group
|
|
|
|
|
(if withvalues
|
|
|
|
|
(gnus-method-to-server
|
|
|
|
|
(nnmairix-backend-to-server gnus-current-select-method))
|
|
|
|
|
(car (nnmairix-get-server)))
|
|
|
|
|
group
|
|
|
|
|
(nnmairix-widget-make-query-from-widgets widgets)
|
|
|
|
|
(widget-value (cadr (assoc "Threads" widgets))))))
|
|
|
|
|
(kill-buffer nnmairix-customize-query-buffer))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-widget-make-query-from-widgets (widgets)
|
|
|
|
|
"Create mairix query from widget values WIDGETS."
|
|
|
|
|
(let (query temp flag)
|
|
|
|
|
;; first we do the editable fields
|
|
|
|
|
(dolist (cur nnmairix-widget-fields-list)
|
|
|
|
|
;; See if checkbox is checked
|
|
|
|
|
(when (widget-value
|
|
|
|
|
(cadr (assoc (concat "c" (caddr cur)) widgets)))
|
|
|
|
|
;; create query for the field
|
|
|
|
|
(push
|
|
|
|
|
(concat
|
|
|
|
|
(nth 1 cur)
|
|
|
|
|
":"
|
|
|
|
|
(nnmairix-replace-illegal-chars
|
|
|
|
|
(widget-value
|
|
|
|
|
(cadr (assoc (concat "e" (caddr cur)) widgets)))))
|
|
|
|
|
query)))
|
|
|
|
|
;; Flags
|
|
|
|
|
(when (member 'flags nnmairix-widget-other)
|
|
|
|
|
(setq flag
|
|
|
|
|
(mapconcat
|
|
|
|
|
(function
|
|
|
|
|
(lambda (flag)
|
|
|
|
|
(setq temp
|
|
|
|
|
(widget-value (cadr (assoc (car flag) nnmairix-widgets))))
|
|
|
|
|
(if (string= "yes" temp)
|
|
|
|
|
(cadr flag)
|
|
|
|
|
(if (string= "no" temp)
|
|
|
|
|
(concat "-" (cadr flag))))))
|
|
|
|
|
'(("seen" "s") ("replied" "r") ("flagged" "f")) ""))
|
|
|
|
|
(when (not (zerop (length flag)))
|
|
|
|
|
(push (concat "F:" flag) query)))
|
|
|
|
|
;; return query string
|
|
|
|
|
(mapconcat 'identity query " ")))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-widget-create-query (&optional values)
|
|
|
|
|
"Create widgets for creating mairix queries.
|
|
|
|
|
Fill in VALUES if based on an article."
|
|
|
|
|
(let (allwidgets)
|
|
|
|
|
(when (get-buffer nnmairix-customize-query-buffer)
|
|
|
|
|
(kill-buffer nnmairix-customize-query-buffer))
|
|
|
|
|
(switch-to-buffer nnmairix-customize-query-buffer)
|
|
|
|
|
(kill-all-local-variables)
|
|
|
|
|
(erase-buffer)
|
|
|
|
|
(widget-insert "Specify your query for Mairix (check boxes for activating fields):\n\n")
|
|
|
|
|
(widget-insert "(Whitespaces will be converted to ',' (i.e. AND). Use '/' for OR.)\n\n")
|
|
|
|
|
; (make-local-variable 'nnmairix-widgets)
|
|
|
|
|
(setq nnmairix-widgets (nnmairix-widget-build-editable-fields values))
|
|
|
|
|
(when (member 'flags nnmairix-widget-other)
|
|
|
|
|
(widget-insert "\nFlags:\n Seen: ")
|
|
|
|
|
(nnmairix-widget-add "seen"
|
|
|
|
|
'menu-choice
|
|
|
|
|
:value "ignore"
|
|
|
|
|
'(item "yes") '(item "no") '(item "ignore"))
|
|
|
|
|
(widget-insert " Replied: ")
|
|
|
|
|
(nnmairix-widget-add "replied"
|
|
|
|
|
'menu-choice
|
|
|
|
|
:value "ignore"
|
|
|
|
|
'(item "yes") '(item "no") '(item "ignore"))
|
|
|
|
|
(widget-insert " Ticked: ")
|
|
|
|
|
(nnmairix-widget-add "flagged"
|
|
|
|
|
'menu-choice
|
|
|
|
|
:value "ignore"
|
|
|
|
|
'(item "yes") '(item "no") '(item "ignore")))
|
|
|
|
|
(when (member 'threads nnmairix-widget-other)
|
|
|
|
|
(widget-insert "\n")
|
|
|
|
|
(nnmairix-widget-add "Threads" 'checkbox nil))
|
|
|
|
|
(widget-insert " Show full threads\n\n")))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-widget-build-editable-fields (values)
|
|
|
|
|
"Build editable field widgets in `nnmairix-widget-fields-list'.
|
|
|
|
|
VALUES may contain values for editable fields from current article."
|
|
|
|
|
;; how can this be done less ugly?
|
|
|
|
|
(let ((ret))
|
|
|
|
|
(mapc
|
|
|
|
|
(function
|
|
|
|
|
(lambda (field)
|
|
|
|
|
(setq field (caddr field))
|
|
|
|
|
(setq ret
|
|
|
|
|
(nconc
|
|
|
|
|
(list
|
|
|
|
|
(list
|
|
|
|
|
(concat "c" field)
|
|
|
|
|
(widget-create 'checkbox
|
|
|
|
|
:tag field
|
|
|
|
|
:notify (lambda (widget &rest ignore)
|
|
|
|
|
(nnmairix-widget-toggle-activate widget))
|
|
|
|
|
nil)))
|
|
|
|
|
(list
|
|
|
|
|
(list
|
|
|
|
|
(concat "e" field)
|
|
|
|
|
(widget-create 'editable-field
|
|
|
|
|
:size 60
|
|
|
|
|
:format (concat " " field ":"
|
|
|
|
|
(make-string (- 11 (length field)) ?\ )
|
|
|
|
|
"%v")
|
|
|
|
|
:value (or (cadr (assoc field values)) ""))))
|
|
|
|
|
ret))
|
|
|
|
|
(widget-insert "\n")
|
|
|
|
|
;; Deactivate editable field
|
|
|
|
|
(widget-apply (cadr (nth 1 ret)) :deactivate)))
|
|
|
|
|
nnmairix-widget-fields-list)
|
|
|
|
|
ret))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-widget-add (name &rest args)
|
|
|
|
|
"Add a widget NAME with optional ARGS."
|
|
|
|
|
(push
|
|
|
|
|
(list name
|
|
|
|
|
(apply 'widget-create args))
|
|
|
|
|
nnmairix-widgets))
|
|
|
|
|
|
|
|
|
|
(defun nnmairix-widget-toggle-activate (widget)
|
|
|
|
|
"Toggle activation status of WIDGET dependent on corresponding checkbox value."
|
|
|
|
|
(let ((field (widget-get widget :tag)))
|
|
|
|
|
(if (widget-value widget)
|
|
|
|
|
(widget-apply
|
|
|
|
|
(cadr (assoc (concat "e" field) nnmairix-widgets))
|
|
|
|
|
:activate)
|
|
|
|
|
(widget-apply
|
|
|
|
|
(cadr (assoc (concat "e" field) nnmairix-widgets))
|
|
|
|
|
:deactivate)))
|
|
|
|
|
(widget-setup))
|
|
|
|
|
|
|
|
|
|
(provide 'nnmairix)
|
|
|
|
|
|
|
|
|
|
;; arch-tag: bb187498-b229-4a55-8c07-6d3f80713e94
|
|
|
|
|
;;; nnmairix.el ends here
|
