[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to mairix.el
|
From: |
Chong Yidong |
|
Subject: |
[Emacs-diffs] Changes to mairix.el |
|
Date: |
Tue, 29 Jul 2008 17:41:01 +0000 |
CVSROOT: /sources/emacs
Module name: emacs
Changes by: Chong Yidong <cyd> 08/07/29 17:41:01
Index: mairix.el
===================================================================
RCS file: mairix.el
diff -N mairix.el
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ mairix.el 29 Jul 2008 17:41:01 -0000 1.1
@@ -0,0 +1,952 @@
+;;; mairix.el --- Mairix interface for Emacs
+
+;; Copyright (C) 2008 Free Software Foundation, Inc.
+
+;; Author: David Engster <address@hidden>
+;; 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
+
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to mairix.el,
Chong Yidong <=