Mercurial > emacs
changeset 97093:1f61c691b0c0
New file.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Tue, 29 Jul 2008 17:41:01 +0000 |
parents | 65a19be3f79b |
children | e907e485ee3c |
files | lisp/net/mairix.el |
diffstat | 1 files changed, 952 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/net/mairix.el Tue Jul 29 17:41:01 2008 +0000 @@ -0,0 +1,952 @@ +;;; mairix.el --- Mairix interface for Emacs + +;; Copyright (C) 2008 Free Software Foundation, Inc. + +;; Author: David Engster <dengste@eml.cc> +;; Keywords: mail searching + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; 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 +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This is an interface to the mairix mail search engine. Mairix is +;; written by Richard Curnow and is licensed under the GPL. See the +;; home page for details: +;; +;; http://www.rpcurnow.force9.co.uk/mairix/ +;; +;; Features of mairix.el: +;; +;; * Query mairix with a search term. +;; * Currently supported Emacs mail programs: RMail, Gnus (mbox only), +;; and VM. +;; * Generate search queries using graphical widgets. +;; * Generate search queries based on currently displayed mail. +;; * Save regularly used searches in your .emacs customize section. +;; * Major mode for viewing, editing and querying saved searches. +;; * Update mairix database. +;; +;; Please note: There are currently no pre-defined key bindings, since +;; I guess these would depend on the used mail program. See the docs +;; for an overview of the provided interactive functions. +;; +;; Attention Gnus users: If you use Gnus with maildir or nnml, you +;; should use the native Gnus back end nnmairix.el instead, since it +;; has more features and is better integrated with Gnus. This +;; interface is essentially a stripped down version of nnmairix.el. +;; +;; Currently, RMail, Gnus (with mbox files), and VM are supported as +;; mail programs, but it is pretty easy to interface it with other +;; ones as well. Please see the docs and the source for details. +;; In a nutshell: include your favourite mail program in +;; `mairix-mail-program' and write functions for +;; `mairix-display-functions' and `mairix-get-mail-header-functions'. +;; If you have written such functions for your Emacs mail program of +;; choice, please let me know, so that I can eventually include them +;; in future version of mairix.el. + +;;; History: + +;; 07/28/2008: version 0.2. Added VM interface, written by Ulrich +;; Mueller. + +;; 07/14/2008: Initial release + +;;; Code: + +(require 'widget) +(require 'cus-edit) + +(eval-when-compile + (require 'cl)) + +;;; Keymappings + +;; (currently none - please create them yourself) + +;;; Customizable variables + +(defgroup mairix nil + "Mairix interface for Emacs." + :group 'mail) + +(defcustom mairix-file-path "~/" + "Path where output files produced by Mairix should be stored." + :type 'directory + :group 'mairix) + +(defcustom mairix-search-file "mairixsearch.mbox" + "Name of the default file for storing the searches. +Note that this will be prefixed by `mairix-file-path'." + :type 'string + :group 'mairix) + +(defcustom mairix-command "mairix" + "Command for calling mairix. +You can add further options here if you want to, but better use +`mairix-update-options' instead." + :type 'string + :group 'mairix) + +(defcustom mairix-output-buffer "*mairix output*" + "Name of the buffer for the output of the mairix binary." + :type 'string + :group 'mairix) + +(defcustom mairix-customize-query-buffer "*mairix query*" + "Name of the buffer for customizing a search query." + :type 'string + :group 'mairix) + +(defcustom mairix-saved-searches-buffer "*mairix searches*" + "Name of the buffer for displaying saved searches." + :type 'string + :group 'mairix) + +(defcustom 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)." + :type '(repeat string) + :group 'mairix) + +(defcustom mairix-search-options '("-Q") + "Options when calling mairix for searching. +The default is '-Q' for making searching faster." + :type '(repeat string) + :group 'mairix) + +(defcustom mairix-synchronous-update nil + "Defines if Emacs should wait for the mairix database update." + :type 'boolean + :group 'mairix) + +(defcustom mairix-saved-searches nil + "Saved mairix searches. +The entries are: Name of the search, Mairix query string, Name of +the file (nil: use `mairix-search-file' as default), Search whole +threads (nil or t). Note that the file will be prefixed by +`mairix-file-path'." + :type '(repeat (list (string :tag "Name") + (string :tag "Query") + (choice :tag "File" + (const :tag "default") + file) + (boolean :tag "Threads"))) + :group 'mairix) + +(defcustom mairix-mail-program 'rmail + "Mail program used to display search results. +Currently RMail, Gnus (mbox), and VM are supported. If you use Gnus +with maildir, use nnmairix.el instead." + :type '(choice (const :tag "RMail" rmail) + (const :tag "Gnus mbox" gnus) + (const :tag "VM" vm)) + :group 'mairix) + +(defcustom mairix-display-functions + '((rmail mairix-rmail-display) + (gnus mairix-gnus-ephemeral-nndoc) + (vm mairix-vm-display)) + "Specifies which function should be called for displaying search results. +This is an alist where each entry consists of a symbol from +`mairix-mail-program' and the corresponding function for +displaying the search results. The function will be called with +the mailbox file produced by mairix as the single argument." + :type '(repeat (list (symbol :tag "Mail program") + (function))) + :group 'mairix) + +(defcustom mairix-get-mail-header-functions + '((rmail mairix-rmail-fetch-field) + (gnus mairix-gnus-fetch-field) + (vm mairix-vm-fetch-field)) + "Specifies function for obtaining a header field from the current mail. +This is an alist where each entry consists of a symbol from +`mairix-mail-program' and the corresponding function for +obtaining a header field from the current displayed mail. The +function will be called with the mail header string as single +argument. You can use nil if you do not have such a function for +your mail program, but then searches based on the current mail +won't work." + :type '(repeat (list (symbol :tag "Mail program") + (choice :tag "Header function" + (const :tag "none") + function))) + :group 'mairix) + +(defcustom mairix-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." + :type 'function + :group 'mairix) + +;; Other variables + +(defvar mairix-widget-fields-list + '(("from" "f" "From") ("to" "t" "To") ("cc" "c" "Cc") + ("subject" "s" "Subject") ("to" "tc" "To or Cc") + ("from" "a" "Address") (nil "Body" "b") (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).") + +(defvar mairix-widget-other + '(threads flags) + "Other editable mairix commands when using customization widgets. +Currently there are 'threads and 'flags.") + +;;;; Internal variables + +(defvar mairix-last-search nil) +(defvar mairix-searches-changed nil) + +;;;; Interface functions for Emacs mail programs + +;;; RMail + +;; Display function: +(autoload 'rmail "rmail") +(autoload 'rmail-summary-displayed "rmail") +(autoload 'rmail-summary "rmailsum") +(eval-when-compile + (defvar rmail-buffer)) + +(defun mairix-rmail-display (folder) + "Display mbox file FOLDER with RMail." + (let (show-summary) + ;; If it exists, select existing RMail window + (when (and (boundp 'rmail-buffer) + rmail-buffer) + (set-buffer rmail-buffer) + (when (get-buffer-window rmail-buffer) + (select-window (get-buffer-window rmail-buffer)) + (setq show-summary (rmail-summary-displayed)))) + ;; check if folder is already open and if so, kill it + (when (get-buffer (file-name-nondirectory folder)) + (set-buffer + (get-buffer (file-name-nondirectory folder))) + (set-buffer-modified-p nil) + (kill-buffer nil)) + (rmail folder) + ;; Update summary if necessary + (when show-summary + (rmail-summary)))) + +;; Fetching mail header field: +(autoload 'rmail-narrow-to-non-pruned-header "rmail") +(defun mairix-rmail-fetch-field (field) + "Get mail header FIELD for current message using RMail." + (unless (and (boundp 'rmail-buffer) + rmail-buffer) + (error "No RMail buffer available")) + (save-excursion + (set-buffer rmail-buffer) + (save-restriction + (rmail-narrow-to-non-pruned-header) + (mail-fetch-field field)))) + +;;; Gnus +(eval-when-compile + (defvar gnus-article-buffer) + (autoload 'gnus-summary-toggle-header "gnus-sum") + (autoload 'gnus-buffer-exists-p "gnus-util") + (autoload 'message-field-value "message") + (autoload 'gnus-group-read-ephemeral-group "gnus-group") + (autoload 'gnus-alive-p "gnus-util")) + +;; Display function: +(defun mairix-gnus-ephemeral-nndoc (folder) + "Create ephemeral nndoc group for reading mbox file FOLDER in Gnus." + (unless (gnus-alive-p) + (error "Gnus is not running")) + (gnus-group-read-ephemeral-group + ;; add randomness to group string to prevent Gnus from using a + ;; cached version + (format "mairix.%s" (number-to-string (random 10000))) + `(nndoc "mairix" + (nndoc-address ,folder) + (nndoc-article-type mbox)))) + +;; Fetching mail header field: +(defun mairix-gnus-fetch-field (field) + "Get mail header FIELD for current message using Gnus." + (unless (gnus-alive-p) + (error "Gnus is not running")) + (save-excursion + (unless (gnus-buffer-exists-p gnus-article-buffer) + (error "No article buffer available")) + (set-buffer gnus-article-buffer) + (gnus-summary-toggle-header 1) + (message-field-value field))) + +;;; VM +;;; written by Ulrich Mueller + +(eval-when-compile + (autoload 'vm-quit "vm-folder") + (autoload 'vm-visit-folder "vm") + (autoload 'vm-select-folder-buffer "vm-macro") + (autoload 'vm-check-for-killed-summary "vm-misc") + (autoload 'vm-get-header-contents "vm-summary") + (autoload 'vm-check-for-killed-summary "vm-misc") + (autoload 'vm-error-if-folder-empty "vm-misc") + (autoload 'vm-select-marked-or-prefixed-messages "vm-folder")) + +;; Display function +(defun mairix-vm-display (folder) + "Display mbox file FOLDER with VM." + (require 'vm) + ;; check if folder is already open and if so, kill it + (let ((buf (get-file-buffer folder))) + (when buf + (set-buffer buf) + (set-buffer-modified-p nil) + (condition-case nil + (vm-quit t) + (error nil)) + (kill-buffer buf))) + (vm-visit-folder folder t)) + +;; Fetching mail header field +(defun mairix-vm-fetch-field (field) + "Get mail header FIELD for current message using VM." + (save-excursion + (vm-select-folder-buffer) + (vm-check-for-killed-summary) + (vm-error-if-folder-empty) + (vm-get-header-contents + (car (vm-select-marked-or-prefixed-messages 1)) field))) + +;;;; Main interactive functions + +(defun mairix-search (search threads) + "Call Mairix with SEARCH. +If THREADS is t, also display whole threads of found +messages. Results will be put into the default search file." + (interactive + (list + (read-string "Query: ") + (y-or-n-p "Include threads? "))) + (when (mairix-call-mairix + (split-string search) + nil + threads) + (mairix-show-folder mairix-search-file))) + +(defun mairix-use-saved-search () + "Use a saved search for querying Mairix." + (interactive) + (let* ((completions + (mapcar (lambda (el) (list (car el))) mairix-saved-searches)) + (search (completing-read "Name of search: " completions)) + (query (assoc search mairix-saved-searches)) + (folder (nth 2 query))) + (when (not folder) + (setq folder mairix-search-file)) + (when query + (mairix-call-mairix + (split-string (nth 1 query)) + folder + (car (last query))) + (mairix-show-folder folder)))) + +(defun mairix-save-search () + "Save the last search." + (interactive) + (let* ((name (read-string "Name of the search: ")) + (exist (assoc name mairix-saved-searches))) + (if (not exist) + (add-to-list 'mairix-saved-searches + (append (list name) mairix-last-search)) + (when + (y-or-n-p + "There is already a search with this name. \ +Overwrite existing entry? ") + (setcdr (assoc name mairix-saved-searches) mairix-last-search)))) + (mairix-select-save)) + +(defun mairix-edit-saved-searches-customize () + "Edit the list of saved searches in a customization buffer." + (interactive) + (custom-buffer-create (list (list 'mairix-saved-searches 'custom-variable)) + "*Customize Mairix Query*" + (concat "\n\n" (make-string 65 ?=) +"\nYou can now customize your saved Mairix searches by modifying\n\ +the variable mairix-saved-searches. Don't forget to save your\nchanges \ +in your .emacs by pressing 'Save for Future Sessions'.\n" +(make-string 65 ?=) "\n"))) + +(autoload 'mail-strip-quoted-names "mail-utils") +(defun mairix-search-from-this-article (threads) + "Search messages from sender of the current article. +This is effectively a shortcut for calling `mairix-search' with +f:current_from. If prefix THREADS is non-nil, include whole +threads." + (interactive "P") + (let ((get-mail-header + (cadr (assq mairix-mail-program mairix-get-mail-header-functions)))) + (if get-mail-header + (mairix-search + (format "f:%s" + (mail-strip-quoted-names + (funcall get-mail-header "from"))) + threads) + (error "No function for obtaining mail header specified")))) + +(defun mairix-search-thread-this-article () + "Search thread for the current article. +This is effectively a shortcut for calling `mairix-search' +with m:msgid of the current article and enabled threads." + (interactive) + (let ((get-mail-header + (cadr (assq mairix-mail-program mairix-get-mail-header-functions))) + mid) + (unless get-mail-header + (error "No function for obtaining mail header specified")) + (setq mid (funcall get-mail-header "message-id")) + (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))) + (mairix-search + (format "m:%s" mid) t))) + +(defun mairix-widget-search-based-on-article () + "Create mairix query based on current article using widgets." + (interactive) + (mairix-widget-search + (mairix-widget-get-values))) + +(defun mairix-edit-saved-searches () + "Edit current mairix searches." + (interactive) + (switch-to-buffer mairix-saved-searches-buffer) + (erase-buffer) + (setq mairix-searches-changed nil) + (mairix-build-search-list) + (mairix-searches-mode) + (hl-line-mode)) + +(defvar mairix-widgets) + +(defun mairix-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 mairix-widget-select-window-function) + ;; generate widgets + (mairix-widget-create-query mvalues) + ;; generate Buttons + (widget-create 'push-button + :notify + (lambda (&rest ignore) + (mairix-widget-send-query mairix-widgets)) + "Send Query") + (widget-insert " ") + (widget-create 'push-button + :notify + (lambda (&rest ignore) + (mairix-widget-save-search mairix-widgets)) + "Save search") + (widget-insert " ") + (widget-create 'push-button + :notify (lambda (&rest ignore) + (kill-buffer mairix-customize-query-buffer)) + "Cancel") + (use-local-map widget-keymap) + (widget-setup) + (goto-char (point-min))) + +(defun mairix-update-database () + "Call mairix for updating the database for SERVERS. +Mairix will be called asynchronously unless +`mairix-synchronous-update' is t. Mairix will be called with +`mairix-update-options'." + (interactive) + (let ((commandsplit (split-string mairix-command)) + args) + (if mairix-synchronous-update + (progn + (setq args (append (list (car commandsplit) nil + (get-buffer-create mairix-output-buffer) + nil))) + (if (> (length commandsplit) 1) + (setq args (append args + (cdr commandsplit) + mairix-update-options)) + (setq args (append args mairix-update-options))) + (apply 'call-process args)) + (progn + (message "Updating mairix database...") + (setq args (append (list "mairixupdate" (get-buffer-create mairix-output-buffer) + (car commandsplit)))) + (if (> (length commandsplit) 1) + (setq args (append args (cdr commandsplit) mairix-update-options)) + (setq args (append args mairix-update-options))) + (set-process-sentinel + (apply 'start-process args) + 'mairix-sentinel-mairix-update-finished))))) + + +;;;; Helper functions + +(defun mairix-show-folder (folder) + "Display mail FOLDER with mail program. +The mail program is given by `mairix-mail-program'." + (let ((display-function + (cadr (assq mairix-mail-program mairix-display-functions)))) + (if display-function + (funcall display-function + (concat + (file-name-as-directory + (expand-file-name mairix-file-path)) + folder)) + (error "No mail program set")))) + +(defun mairix-call-mairix (query file threads) + "Call Mairix with QUERY and output FILE. +If FILE is nil, use default. If THREADS is non-nil, also return +whole threads. Function returns t if messages were found." + (let* ((commandsplit (split-string mairix-command)) + (args (cons (car commandsplit) + `(nil ,(get-buffer-create mairix-output-buffer) nil))) + rval) + (with-current-buffer mairix-output-buffer + (erase-buffer)) + (when (> (length commandsplit) 1) + (setq args (append args (cdr commandsplit)))) + (when threads + (setq args (append args '("-t")))) + (when (stringp query) + (setq query (split-string query))) + (setq mairix-last-search (list (mapconcat 'identity query " ") + file threads)) + (when (not file) + (setq file mairix-search-file)) + (setq file + (concat + (file-name-as-directory + (expand-file-name + mairix-file-path)) + file)) + (setq rval + (apply 'call-process + (append args (list "-o" file) query))) + (if (zerop rval) + (with-current-buffer mairix-output-buffer + (goto-char (point-min)) + (re-search-forward "^Matched.*messages") + (message (match-string 0))) + (if (and (= rval 1) + (with-current-buffer mairix-output-buffer + (goto-char (point-min)) + (looking-at "^Matched 0 messages"))) + (message "No messages found") + (error "Error running Mairix. See buffer %s for details" + mairix-output-buffer))) + (zerop rval))) + +(defun mairix-replace-illegal-chars (header) + "Replace illegal characters in HEADER for mairix query." + (when 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)) + +(defun mairix-sentinel-mairix-update-finished (proc status) + "Sentinel for mairix update process PROC with STATUS." + (if (equal status "finished\n") + (message "Updating mairix database... done") + (error "There was an error updating the mairix database. \ +See %s for details" mairix-output-buffer))) + + +;;;; Widget stuff + + + +(defun mairix-widget-send-query (widgets) + "Send query from WIDGETS to mairix binary." + (mairix-search + (mairix-widget-make-query-from-widgets widgets) + (if (widget-value (cadr (assoc "Threads" widgets))) + t + -1)) + (kill-buffer mairix-customize-query-buffer)) + +(defun mairix-widget-save-search (widgets) + "Save search based on WIDGETS for future use." + (let ((mairix-last-search + `( ,(mairix-widget-make-query-from-widgets widgets) + nil + ,(widget-value (cadr (assoc "Threads" widgets)))))) + (mairix-save-search) + (kill-buffer mairix-customize-query-buffer))) + +(defun mairix-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 mairix-widget-fields-list) + ;; See if checkbox is checked + (when (widget-value + (cadr (assoc (concat "c" (car (cddr cur))) widgets))) + ;; create query for the field + (push + (concat + (nth 1 cur) + ":" + (mairix-replace-illegal-chars + (widget-value + (cadr (assoc (concat "e" (car (cddr cur))) widgets))))) + query))) + ;; Flags + (when (member 'flags mairix-widget-other) + (setq flag + (mapconcat + (function + (lambda (flag) + (setq temp + (widget-value (cadr (assoc (car flag) mairix-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 mairix-widget-create-query (&optional values) + "Create widgets for creating mairix queries. +Fill in VALUES if based on an article." + (let (allwidgets) + (when (get-buffer mairix-customize-query-buffer) + (kill-buffer mairix-customize-query-buffer)) + (switch-to-buffer mairix-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") + (setq mairix-widgets (mairix-widget-build-editable-fields values)) + (when (member 'flags mairix-widget-other) + (widget-insert "\nFlags:\n Seen: ") + (mairix-widget-add "seen" + 'menu-choice + :value "ignore" + '(item "yes") '(item "no") '(item "ignore")) + (widget-insert " Replied: ") + (mairix-widget-add "replied" + 'menu-choice + :value "ignore" + '(item "yes") '(item "no") '(item "ignore")) + (widget-insert " Ticked: ") + (mairix-widget-add "flagged" + 'menu-choice + :value "ignore" + '(item "yes") '(item "no") '(item "ignore"))) + (when (member 'threads mairix-widget-other) + (widget-insert "\n") + (mairix-widget-add "Threads" 'checkbox nil)) + (widget-insert " Show full threads\n\n"))) + +(defun mairix-widget-build-editable-fields (values) + "Build editable field widgets in `nnmairix-widget-fields-list'. +VALUES may contain values for editable fields from current article." + (let ((ret)) + (mapc + (function + (lambda (field) + (setq field (car (cddr field))) + (setq + ret + (nconc + (list + (list + (concat "c" field) + (widget-create 'checkbox + :tag field + :notify (lambda (widget &rest ignore) + (mairix-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))) + mairix-widget-fields-list) + ret)) + +(defun mairix-widget-add (name &rest args) + "Add a widget NAME with optional ARGS." + (push + (list name + (apply 'widget-create args)) + mairix-widgets)) + +(defun mairix-widget-toggle-activate (widget) + "Toggle activation status of WIDGET depending on checkbox value." + (let ((field (widget-get widget :tag))) + (if (widget-value widget) + (widget-apply + (cadr (assoc (concat "e" field) mairix-widgets)) + :activate) + (widget-apply + (cadr (assoc (concat "e" field) mairix-widgets)) + :deactivate))) + (widget-setup)) + + +;;;; Major mode for editing/deleting/saving searches + +(defvar mairix-searches-mode-map nil "'mairix-searches-mode' keymap.") + +;; Keymap +(if (not mairix-searches-mode-map) + (let ((map (make-keymap))) + (define-key map [(return)] 'mairix-select-search) + (define-key map [(down)] 'mairix-next-search) + (define-key map [(up)] 'mairix-previous-search) + (define-key map [(right)] 'mairix-next-search) + (define-key map [(left)] 'mairix-previous-search) + (define-key map "\C-p" 'mairix-previous-search) + (define-key map "\C-n" 'mairix-next-search) + (define-key map [(q)] 'mairix-select-quit) + (define-key map [(e)] 'mairix-select-edit) + (define-key map [(d)] 'mairix-select-delete) + (define-key map [(s)] 'mairix-select-save) + (setq mairix-searches-mode-map map))) + +(defvar mairix-searches-mode-font-lock-keywords) + +(defun mairix-searches-mode () + "Major mode for editing mairix searches." + (interactive) + (kill-all-local-variables) + (setq major-mode 'mairix-searches-mode) + (setq mode-name "mairix-searches") + (set-syntax-table text-mode-syntax-table) + (use-local-map mairix-searches-mode-map) + (make-local-variable 'font-lock-defaults) + (setq mairix-searches-mode-font-lock-keywords + (list (list "^\\([0-9]+\\)" + '(1 font-lock-constant-face)) + (list "^[0-9 ]+\\(Name:\\) \\(.*\\)" + '(1 font-lock-keyword-face) '(2 font-lock-string-face)) + (list "^[ ]+\\(Query:\\) \\(.*\\) , " + '(1 font-lock-keyword-face) '(2 font-lock-string-face)) + (list ", \\(Threads:\\) \\(.*\\)" + '(1 font-lock-keyword-face) '(2 font-lock-constant-face)) + (list "^\\([A-Z].*\\)$" + '(1 font-lock-comment-face)) + (list "^[ ]+\\(Folder:\\) \\(.*\\)" + '(1 font-lock-keyword-face) '(2 font-lock-string-face)))) + (setq font-lock-defaults '(mairix-searches-mode-font-lock-keywords))) + +(defun mairix-build-search-list () + "Display saved searches in current buffer." + (insert "These are your current saved mairix searches.\n\ +You may use the following keys in this buffer: \n\ +Return: execute search, e: edit, d: delete, s: save, q: quit\n\ +Use cursor keys or C-n,C-p to select next/previous search.\n\n") + (let ((num 0) + (beg (point)) + current) + (while (< num (length mairix-saved-searches)) + (setq current (nth num mairix-saved-searches)) + (setq num (1+ num)) + (mairix-insert-search-line num current) + (insert "\n")) + (goto-char beg))) + +(defun mairix-insert-search-line (number field) + "Insert new mairix query with NUMBER and values FIELD in buffer." + (insert + (format "%d Name: %s\n Query: %s , Threads: %s\n Folder: %s\n" + number + (car field) + (nth 1 field) + (if (nth 3 field) + "Yes" + "No") + (if (nth 2 field) + (nth 2 field) + "Default")))) + +(defun mairix-select-search () + "Call mairix with currently selected search." + (interactive) + (beginning-of-line) + (if (not (looking-at "[0-9]+ Name")) + (progn + (ding) + (message "Put cursor on a line with a search name first")) + (progn + (let* ((query (nth + (1- (read (current-buffer))) + mairix-saved-searches)) + (folder (nth 2 query))) + (when (not folder) + (setq folder mairix-search-file)) + (mairix-call-mairix + (split-string (nth 1 query)) + folder + (car (last query))) + (mairix-select-quit) + (mairix-show-folder folder))))) + +(defun mairix-next-search () + "Jump to next search." + (interactive) + (if (search-forward-regexp "^[0-9]+" + (point-max) + t + 2) + (beginning-of-line) + (ding))) + +(defun mairix-previous-search () + "Jump to previous search." + (interactive) + (if (search-backward-regexp "^[0-9]+" + (point-min) + t) + (beginning-of-line) + (ding))) + +(defun mairix-select-quit () + "Quit mairix search mode." + (interactive) + (when mairix-searches-changed + (mairix-select-save)) + (kill-buffer nil)) + +(defun mairix-select-save () + "Save current mairix searches." + (interactive) + (when (y-or-n-p "Save mairix searches permanently in your .emacs? ") + (customize-save-variable 'mairix-saved-searches mairix-saved-searches))) + +(defun mairix-select-edit () + "Edit currently selected mairix search." + (interactive) + (beginning-of-line) + (if (not (looking-at "[0-9]+ Name")) + (error "Put cursor on a line with a search name first") + (progn + (let* ((number (1- (read (current-buffer)))) + (query (nth number mairix-saved-searches)) + (folder (nth 2 query)) + newname newquery newfolder threads) + (backward-char) + (setq newname (read-string "Name of the search: " (car query))) + (when (assoc newname (remq (nth number mairix-saved-searches) + mairix-saved-searches)) + (error "This name does already exist")) + (setq newquery (read-string "Query: " (nth 1 query))) + (setq threads (y-or-n-p "Include whole threads? ")) + (setq newfolder + (read-string "Mail folder (use empty string for default): " + folder)) + (when (zerop (length newfolder)) + (setq newfolder nil)) + ;; set new values + (setcar (nth number mairix-saved-searches) newname) + (setcdr (nth number mairix-saved-searches) + (list newquery newfolder threads)) + (setq mairix-searches-changed t) + (let ((beg (point))) + (forward-line 3) + (end-of-line) + (delete-region beg (point)) + (mairix-insert-search-line (1+ number) + (nth number mairix-saved-searches)) + (goto-char beg)))))) + +(defun mairix-select-delete () + "Delete currently selected mairix search." + (interactive) + (if (not (looking-at "[0-9]+ Name")) + (error "Put cursor on a line with a search name first") + (progn + (let* ((number (1- (read (current-buffer)))) + (query (nth number mairix-saved-searches)) + beg) + (backward-char) + (when (y-or-n-p (format "Delete search %s ? " (car query))) + (setq mairix-saved-searches + (delq query mairix-saved-searches)) + (setq mairix-searches-changed t) + (setq beg (point)) + (forward-line 4) + (beginning-of-line) + (delete-region beg (point)) + (while (search-forward-regexp "^[0-9]+" + (point-max) + t + 1) + (replace-match (number-to-string + (setq number (1+ number))))))) + (beginning-of-line)))) + +(defun mairix-widget-get-values () + "Create values for editable fields from current article." + (let ((get-mail-header + (cadr (assq mairix-mail-program mairix-get-mail-header-functions)))) + (if get-mail-header + (save-excursion + (save-restriction + (mapcar + (function + (lambda (field) + (list (car (cddr field)) + (if (car field) + (mairix-replace-illegal-chars + (funcall get-mail-header (car field))) + nil)))) + mairix-widget-fields-list))) + (error "No function for obtaining mail header specified")))) + + +(provide 'mairix) + +;;; mairix.el ends here +