code.delx.au - gnu-emacs/blob - lisp/net/mairix.el

   1 ;;; mairix.el --- Mairix interface for Emacs
   2
   3 ;; Copyright (C) 2008-2012  Free Software Foundation, Inc.
   4
   5 ;; Author: David Engster <dengste@eml.cc>
   6 ;; Keywords: mail searching
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; This is an interface to the mairix mail search engine.  Mairix is
  26 ;; written by Richard Curnow and is licensed under the GPL.  See the
  27 ;; home page for details:
  28 ;;
  29 ;; http://www.rpcurnow.force9.co.uk/mairix/
  30 ;;
  31 ;; Features of mairix.el:
  32 ;;
  33 ;; * Query mairix with a search term.
  34 ;; * Currently supported Emacs mail programs: RMail, Gnus (mbox only),
  35 ;;   and VM.
  36 ;; * Generate search queries using graphical widgets.
  37 ;; * Generate search queries based on currently displayed mail.
  38 ;; * Save regularly used searches in your .emacs customize section.
  39 ;; * Major mode for viewing, editing and querying saved searches.
  40 ;; * Update mairix database.
  41 ;;
  42 ;; Please note: There are currently no pre-defined key bindings, since
  43 ;; I guess these would depend on the used mail program.  See the docs
  44 ;; for an overview of the provided interactive functions.
  45 ;;
  46 ;; Attention Gnus users: If you use Gnus with maildir or nnml, you
  47 ;; should use the native Gnus back end nnmairix.el instead, since it
  48 ;; has more features and is better integrated with Gnus.  This
  49 ;; interface is essentially a stripped down version of nnmairix.el.
  50 ;;
  51 ;; Currently, RMail, Gnus (with mbox files), and VM are supported as
  52 ;; mail programs, but it is pretty easy to interface it with other
  53 ;; ones as well.  Please see the docs and the source for details.
  54 ;; In a nutshell: include your favorite mail program in
  55 ;; `mairix-mail-program' and write functions for
  56 ;; `mairix-display-functions' and `mairix-get-mail-header-functions'.
  57 ;; If you have written such functions for your Emacs mail program of
  58 ;; choice, please let me know, so that I can eventually include them
  59 ;; in future version of mairix.el.
  60
  61 ;;; History:
  62
  63 ;; 07/28/2008: version 0.2. Added VM interface, written by Ulrich
  64 ;; Mueller.
  65
  66 ;; 07/14/2008: Initial release
  67
  68 ;;; Code:
  69
  70 (require 'widget)
  71 (require 'cus-edit)
  72
  73 (eval-when-compile
  74   (require 'cl))
  75
  76 ;;; Keymappings
  77
  78 ;; (currently none - please create them yourself)
  79
  80 ;;; Customizable variables
  81
  82 (defgroup mairix nil
  83   "Mairix interface for Emacs."
  84   :group 'mail)
  85
  86 (defcustom mairix-file-path "~/"
  87   "Path where output files produced by Mairix should be stored."
  88   :type 'directory
  89   :group 'mairix)
  90
  91 (defcustom mairix-search-file "mairixsearch.mbox"
  92   "Name of the default file for storing the searches.
  93 Note that this will be prefixed by `mairix-file-path'."
  94   :type 'string
  95   :group 'mairix)
  96
  97 (defcustom mairix-command "mairix"
  98   "Command for calling mairix.
  99 You can add further options here if you want to, but better use
 100 `mairix-update-options' instead."
 101   :type 'string
 102   :group 'mairix)
 103
 104 (defcustom mairix-output-buffer "*mairix output*"
 105   "Name of the buffer for the output of the mairix binary."
 106   :type 'string
 107   :group 'mairix)
 108
 109 (defcustom mairix-customize-query-buffer "*mairix query*"
 110   "Name of the buffer for customizing a search query."
 111   :type 'string
 112   :group 'mairix)
 113
 114 (defcustom mairix-saved-searches-buffer "*mairix searches*"
 115   "Name of the buffer for displaying saved searches."
 116   :type 'string
 117   :group 'mairix)
 118
 119 (defcustom mairix-update-options '("-F" "-Q")
 120   "Options when calling mairix for updating the database.
 121 The default is '-F' and '-Q' for making updates faster.  You
 122 should call mairix without these options from time to
 123 time (e.g. via cron job)."
 124   :type '(repeat string)
 125   :group 'mairix)
 126
 127 (defcustom mairix-search-options '("-Q")
 128   "Options when calling mairix for searching.
 129 The default is '-Q' for making searching faster."
 130   :type '(repeat string)
 131   :group 'mairix)
 132
 133 (defcustom mairix-synchronous-update nil
 134   "Defines if Emacs should wait for the mairix database update."
 135   :type 'boolean
 136   :group 'mairix)
 137
 138 (defcustom mairix-saved-searches nil
 139   "Saved mairix searches.
 140 The entries are: Name of the search, Mairix query string, Name of
 141 the file (nil: use `mairix-search-file' as default), Search whole
 142 threads (nil or t).  Note that the file will be prefixed by
 143 `mairix-file-path'."
 144   :type '(repeat (list (string :tag "Name")
 145                        (string :tag "Query")
 146                        (choice :tag "File"
 147                                (const :tag "default")
 148                                file)
 149                        (boolean :tag "Threads")))
 150   :group 'mairix)
 151
 152 (defcustom mairix-mail-program 'rmail
 153   "Mail program used to display search results.
 154 Currently RMail, Gnus (mbox), and VM are supported.  If you use Gnus
 155 with maildir, use nnmairix.el instead."
 156   :type '(choice (const :tag "RMail" rmail)
 157                  (const :tag "Gnus mbox" gnus)
 158                  (const :tag "VM" vm))
 159   :group 'mairix)
 160
 161 (defcustom mairix-display-functions
 162   '((rmail mairix-rmail-display)
 163     (gnus mairix-gnus-ephemeral-nndoc)
 164     (vm mairix-vm-display))
 165   "Specifies which function should be called for displaying search results.
 166 This is an alist where each entry consists of a symbol from
 167 `mairix-mail-program' and the corresponding function for
 168 displaying the search results.  The function will be called with
 169 the mailbox file produced by mairix as the single argument."
 170   :type '(repeat (list (symbol :tag "Mail program")
 171                        (function)))
 172   :group 'mairix)
 173
 174 (defcustom mairix-get-mail-header-functions
 175   '((rmail mairix-rmail-fetch-field)
 176     (gnus mairix-gnus-fetch-field)
 177     (vm mairix-vm-fetch-field))
 178   "Specifies function for obtaining a header field from the current mail.
 179 This is an alist where each entry consists of a symbol from
 180 `mairix-mail-program' and the corresponding function for
 181 obtaining a header field from the current displayed mail.  The
 182 function will be called with the mail header string as single
 183 argument.  You can use nil if you do not have such a function for
 184 your mail program, but then searches based on the current mail
 185 won't work."
 186   :type '(repeat (list (symbol :tag "Mail program")
 187                        (choice :tag "Header function"
 188                                (const :tag "none")
 189                                function)))
 190   :group 'mairix)
 191
 192 (defcustom mairix-widget-select-window-function
 193   (lambda () (select-window (get-largest-window)))
 194   "Function for selecting the window for customizing the mairix query.
 195 The default chooses the largest window in the current frame."
 196   :type 'function
 197   :group 'mairix)
 198
 199 ;; Other variables
 200
 201 (defvar mairix-widget-fields-list
 202   '(("from" "f" "From") ("to" "t" "To") ("cc" "c" "Cc")
 203     ("subject" "s" "Subject")  ("to" "tc" "To or Cc")
 204     ("from" "a" "Address") (nil "b" "Body") (nil "n" "Attachment")
 205     ("Message-ID" "m" "Message ID") (nil "s" "Size") (nil "d" "Date"))
 206   "Fields that should be editable during interactive query customization.
 207 Header, corresponding mairix command and description for editable
 208 fields in interactive query customization.  The header specifies
 209 which header contents should be inserted into the editable field
 210 when creating a Mairix query based on the current message (can be
 211 nil for disabling this).")
 212
 213 (defvar mairix-widget-other
 214   '(threads flags)
 215   "Other editable mairix commands when using customization widgets.
 216 Currently there are 'threads and 'flags.")
 217
 218 ;;;; Internal variables
 219
 220 (defvar mairix-last-search nil)
 221 (defvar mairix-searches-changed nil)
 222
 223 ;;;; Interface functions for Emacs mail programs
 224
 225 ;;; RMail
 226
 227 ;; Display function:
 228 (autoload 'rmail "rmail")
 229 (autoload 'rmail-summary-displayed "rmail")
 230 (autoload 'rmail-summary "rmailsum")
 231 (defvar rmail-buffer)
 232
 233 (defun mairix-rmail-display (folder)
 234   "Display mbox file FOLDER with RMail."
 235   (let (show-summary)
 236     ;; If it exists, select existing RMail window
 237     (when (and (boundp 'rmail-buffer)
 238                rmail-buffer)
 239       (set-buffer rmail-buffer)
 240       (when (get-buffer-window rmail-buffer)
 241         (select-window (get-buffer-window rmail-buffer))
 242         (setq show-summary (rmail-summary-displayed))))
 243     ;; check if folder is already open and if so, kill it
 244     (when (get-buffer (file-name-nondirectory folder))
 245       (set-buffer
 246        (get-buffer (file-name-nondirectory folder)))
 247       (set-buffer-modified-p nil)
 248       (kill-buffer nil))
 249     (rmail folder)
 250     ;; Update summary if necessary
 251     (when show-summary
 252       (rmail-summary))))
 253
 254 ;; Fetching mail header field:
 255 (defun mairix-rmail-fetch-field (field)
 256   "Get mail header FIELD for current message using RMail."
 257   (unless (and (boundp 'rmail-buffer)
 258                rmail-buffer)
 259     (error "No RMail buffer available"))
 260   ;; At this point, we are in rmail mode, so the rmail funcs are loaded.
 261   (if (fboundp 'rmail-get-header)       ; Emacs 23
 262       (rmail-get-header field)
 263     (with-current-buffer rmail-buffer
 264       (save-restriction
 265         ;; Don't warn about this when compiling Emacs 23.
 266         (with-no-warnings (rmail-narrow-to-non-pruned-header))
 267         (mail-fetch-field field)))))
 268
 269 ;;; Gnus
 270 (eval-when-compile
 271   (defvar gnus-article-buffer)
 272   (autoload 'gnus-summary-toggle-header "gnus-sum")
 273   (autoload 'gnus-buffer-exists-p "gnus-util")
 274   (autoload 'message-field-value "message")
 275   (autoload 'gnus-group-read-ephemeral-group "gnus-group")
 276   (autoload 'gnus-alive-p "gnus-util"))
 277
 278 ;; Display function:
 279 (defun mairix-gnus-ephemeral-nndoc (folder)
 280   "Create ephemeral nndoc group for reading mbox file FOLDER in Gnus."
 281   (unless (gnus-alive-p)
 282     (error "Gnus is not running"))
 283   (gnus-group-read-ephemeral-group
 284    ;; add randomness to group string to prevent Gnus from using a
 285    ;; cached version
 286    (format "mairix.%s" (number-to-string (random 10000)))
 287    `(nndoc "mairix"
 288            (nndoc-address ,folder)
 289            (nndoc-article-type mbox))))
 290
 291 ;; Fetching mail header field:
 292 (defun mairix-gnus-fetch-field (field)
 293   "Get mail header FIELD for current message using Gnus."
 294   (unless (gnus-alive-p)
 295     (error "Gnus is not running"))
 296   (unless (gnus-buffer-exists-p gnus-article-buffer)
 297     (error "No article buffer available"))
 298   (with-current-buffer gnus-article-buffer
 299     (gnus-summary-toggle-header 1)
 300     (message-field-value field)))
 301
 302 ;;; VM
 303 ;;; written by Ulrich Mueller
 304
 305 (eval-when-compile
 306   (autoload 'vm-quit "vm-folder")
 307   (autoload 'vm-visit-folder "vm")
 308   (autoload 'vm-select-folder-buffer "vm-macro")
 309   (autoload 'vm-check-for-killed-summary "vm-misc")
 310   (autoload 'vm-get-header-contents "vm-summary")
 311   (autoload 'vm-check-for-killed-summary "vm-misc")
 312   (autoload 'vm-error-if-folder-empty "vm-misc")
 313   (autoload 'vm-select-marked-or-prefixed-messages "vm-folder"))
 314
 315 ;; Display function
 316 (defun mairix-vm-display (folder)
 317   "Display mbox file FOLDER with VM."
 318   (require 'vm)
 319   ;; check if folder is already open and if so, kill it
 320   (let ((buf (get-file-buffer folder)))
 321     (when buf
 322       (set-buffer buf)
 323       (set-buffer-modified-p nil)
 324       (condition-case nil
 325           (vm-quit t)
 326         (error nil))
 327       (kill-buffer buf)))
 328   (vm-visit-folder folder t))
 329
 330 ;; Fetching mail header field
 331 (defun mairix-vm-fetch-field (field)
 332   "Get mail header FIELD for current message using VM."
 333   (save-excursion
 334     (vm-select-folder-buffer)
 335     (vm-check-for-killed-summary)
 336     (vm-error-if-folder-empty)
 337     (vm-get-header-contents
 338      (car (vm-select-marked-or-prefixed-messages 1)) field)))
 339
 340 ;;;; Main interactive functions
 341
 342 (defun mairix-search (search threads)
 343   "Call Mairix with SEARCH.
 344 If THREADS is non-nil, also display whole threads of found
 345 messages.  Results will be put into the default search file."
 346   (interactive
 347    (list
 348     (read-string "Query: ")
 349     (y-or-n-p "Include threads? ")))
 350   (when (mairix-call-mairix
 351          (split-string search)
 352          nil
 353          threads)
 354     (mairix-show-folder mairix-search-file)))
 355
 356 (defun mairix-use-saved-search ()
 357   "Use a saved search for querying Mairix."
 358   (interactive)
 359   (let* ((completions
 360           (mapcar (lambda (el) (list (car el))) mairix-saved-searches))
 361          (search (completing-read "Name of search: " completions))
 362          (query (assoc search mairix-saved-searches))
 363          (folder (nth 2 query)))
 364     (when (not folder)
 365       (setq folder mairix-search-file))
 366     (when query
 367       (mairix-call-mairix
 368        (split-string (nth 1 query))
 369        folder
 370        (car (last query)))
 371       (mairix-show-folder folder))))
 372
 373 (defun mairix-save-search ()
 374   "Save the last search."
 375   (interactive)
 376   (let* ((name (read-string "Name of the search: "))
 377          (exist (assoc name mairix-saved-searches)))
 378     (if (not exist)
 379         (add-to-list 'mairix-saved-searches
 380                      (append (list name) mairix-last-search))
 381       (when
 382           (y-or-n-p
 383            "There is already a search with this name.  \
 384 Overwrite existing entry? ")
 385         (setcdr (assoc name mairix-saved-searches) mairix-last-search))))
 386   (mairix-select-save))
 387
 388 (defun mairix-edit-saved-searches-customize ()
 389   "Edit the list of saved searches in a customization buffer."
 390   (interactive)
 391   (custom-buffer-create (list (list 'mairix-saved-searches 'custom-variable))
 392                         "*Customize Mairix Query*"
 393                                 (concat "\n\n" (make-string 65 ?=)
 394 "\nYou can now customize your saved Mairix searches by modifying\n\
 395 the variable mairix-saved-searches. Don't forget to save your\nchanges \
 396 in your .emacs by pressing 'Save for Future Sessions'.\n"
 397 (make-string 65 ?=) "\n")))
 398
 399 (autoload 'mail-strip-quoted-names "mail-utils")
 400 (defun mairix-search-from-this-article (threads)
 401   "Search messages from sender of the current article.
 402 This is effectively a shortcut for calling `mairix-search' with
 403 f:current_from.  If prefix THREADS is non-nil, include whole
 404 threads."
 405   (interactive "P")
 406   (let ((get-mail-header
 407          (cadr (assq mairix-mail-program mairix-get-mail-header-functions))))
 408     (if get-mail-header
 409         (mairix-search
 410          (format "f:%s"
 411                  (mail-strip-quoted-names
 412                   (funcall get-mail-header "from")))
 413          threads)
 414       (error "No function for obtaining mail header specified"))))
 415
 416 (defun mairix-search-thread-this-article ()
 417   "Search thread for the current article.
 418 This is effectively a shortcut for calling `mairix-search'
 419 with m:msgid of the current article and enabled threads."
 420   (interactive)
 421   (let ((get-mail-header
 422          (cadr (assq mairix-mail-program mairix-get-mail-header-functions)))
 423         mid)
 424     (unless get-mail-header
 425       (error "No function for obtaining mail header specified"))
 426     (setq mid (funcall get-mail-header "message-id"))
 427     (while (string-match "[<>]" mid)
 428       (setq mid (replace-match "" t t mid)))
 429     ;; mairix somehow does not like '$' in message-id
 430     (when (string-match "\\$" mid)
 431       (setq mid (concat mid "=")))
 432     (while (string-match "\\$" mid)
 433       (setq mid (replace-match "=," t t mid)))
 434     (mairix-search
 435      (format "m:%s" mid) t)))
 436
 437 (defun mairix-widget-search-based-on-article ()
 438   "Create mairix query based on current article using widgets."
 439   (interactive)
 440   (mairix-widget-search
 441    (mairix-widget-get-values)))
 442
 443 (defun mairix-edit-saved-searches ()
 444   "Edit current mairix searches."
 445   (interactive)
 446   (switch-to-buffer mairix-saved-searches-buffer)
 447   (erase-buffer)
 448   (setq mairix-searches-changed nil)
 449   (mairix-build-search-list)
 450   (mairix-searches-mode)
 451   (hl-line-mode))
 452
 453 (defvar mairix-widgets)
 454
 455 (defun mairix-widget-search (&optional mvalues)
 456   "Create mairix query interactively using graphical widgets.
 457 MVALUES may contain values from current article."
 458   (interactive)
 459   ;; Select window for mairix customization
 460   (funcall mairix-widget-select-window-function)
 461   ;; generate widgets
 462   (mairix-widget-create-query mvalues)
 463   ;; generate Buttons
 464   (widget-create 'push-button
 465                  :notify
 466                  (lambda (&rest ignore)
 467                    (mairix-widget-send-query mairix-widgets))
 468                  "Send Query")
 469   (widget-insert "   ")
 470   (widget-create 'push-button
 471                  :notify
 472                  (lambda (&rest ignore)
 473                    (mairix-widget-save-search mairix-widgets))
 474                  "Save search")
 475   (widget-insert "   ")
 476   (widget-create 'push-button
 477                  :notify (lambda (&rest ignore)
 478                            (kill-buffer mairix-customize-query-buffer))
 479                  "Cancel")
 480   (use-local-map widget-keymap)
 481   (widget-setup)
 482   (goto-char (point-min)))
 483
 484 (defun mairix-update-database ()
 485   "Call mairix for updating the database for SERVERS.
 486 Mairix will be called asynchronously unless
 487 `mairix-synchronous-update' is t.  Mairix will be called with
 488 `mairix-update-options'."
 489   (interactive)
 490   (let ((commandsplit (split-string mairix-command))
 491         args)
 492     (if mairix-synchronous-update
 493         (progn
 494           (setq args (append (list (car commandsplit) nil
 495                                    (get-buffer-create mairix-output-buffer)
 496                                    nil)))
 497           (if (> (length commandsplit) 1)
 498               (setq args (append args
 499                                  (cdr commandsplit)
 500                                  mairix-update-options))
 501             (setq args (append args mairix-update-options)))
 502           (apply 'call-process args))
 503       (progn
 504         (message "Updating mairix database...")
 505         (setq args (append (list "mairixupdate" (get-buffer-create mairix-output-buffer)
 506                                  (car commandsplit))))
 507         (if (> (length commandsplit) 1)
 508             (setq args (append args (cdr commandsplit) mairix-update-options))
 509           (setq args (append args mairix-update-options)))
 510         (set-process-sentinel
 511          (apply 'start-process args)
 512          'mairix-sentinel-mairix-update-finished)))))
 513
 514
 515 ;;;; Helper functions
 516
 517 (defun mairix-show-folder (folder)
 518   "Display mail FOLDER with mail program.
 519 The mail program is given by `mairix-mail-program'."
 520   (let ((display-function
 521          (cadr (assq mairix-mail-program mairix-display-functions))))
 522     (if display-function
 523         (funcall display-function
 524                  (concat
 525                   (file-name-as-directory
 526                    (expand-file-name mairix-file-path))
 527                   folder))
 528       (error "No mail program set"))))
 529
 530 (defun mairix-call-mairix (query file threads)
 531   "Call Mairix with QUERY and output FILE.
 532 If FILE is nil, use default.  If THREADS is non-nil, also return
 533 whole threads.  Function returns t if messages were found."
 534   (let* ((commandsplit (split-string mairix-command))
 535          (args (cons (car commandsplit)
 536                      `(nil ,(get-buffer-create mairix-output-buffer) nil)))
 537          rval)
 538     (with-current-buffer mairix-output-buffer
 539       (erase-buffer))
 540     (when (> (length commandsplit) 1)
 541       (setq args (append args (cdr commandsplit))))
 542     (when threads
 543       (setq args (append args '("-t"))))
 544     (when (stringp query)
 545       (setq query (split-string query)))
 546     (setq mairix-last-search (list (mapconcat 'identity query " ")
 547                                      file threads))
 548     (when (not file)
 549       (setq file mairix-search-file))
 550     (setq file
 551           (concat
 552            (file-name-as-directory
 553             (expand-file-name
 554              mairix-file-path))
 555            file))
 556     (setq rval
 557           (apply 'call-process
 558                  (append args (list "-o" file) query)))
 559     (if (zerop rval)
 560         (with-current-buffer mairix-output-buffer
 561           (goto-char (point-min))
 562           (re-search-forward "^Matched.*messages")
 563           (message (match-string 0)))
 564       (if (and (= rval 1)
 565                (with-current-buffer mairix-output-buffer
 566                  (goto-char (point-min))
 567                  (looking-at "^Matched 0 messages")))
 568           (message "No messages found")
 569         (error "Error running Mairix.  See buffer %s for details"
 570                mairix-output-buffer)))
 571     (zerop rval)))
 572
 573 (defun mairix-replace-illegal-chars (header)
 574   "Replace illegal characters in HEADER for mairix query."
 575   (when header
 576     (while (string-match "[^-.@/,& [:alnum:]]" header)
 577       (setq header (replace-match "" t t header)))
 578     (while (string-match "[& ]" header)
 579       (setq header (replace-match "," t t header)))
 580   header))
 581
 582 (defun mairix-sentinel-mairix-update-finished (proc status)
 583   "Sentinel for mairix update process PROC with STATUS."
 584   (if (equal status "finished\n")
 585       (message "Updating mairix database... done")
 586     (error "There was an error updating the mairix database.  \
 587 See %s for details" mairix-output-buffer)))
 588
 589
 590 ;;;; Widget stuff
 591
 592
 593
 594 (defun mairix-widget-send-query (widgets)
 595   "Send query from WIDGETS to mairix binary."
 596   (mairix-search
 597    (mairix-widget-make-query-from-widgets widgets)
 598    (if (widget-value (cadr (assoc "Threads" widgets))) t))
 599   (kill-buffer mairix-customize-query-buffer))
 600
 601 (defun mairix-widget-save-search (widgets)
 602   "Save search based on WIDGETS for future use."
 603   (let ((mairix-last-search
 604          `( ,(mairix-widget-make-query-from-widgets widgets)
 605             nil
 606             ,(widget-value (cadr (assoc "Threads" widgets))))))
 607         (mairix-save-search)
 608         (kill-buffer mairix-customize-query-buffer)))
 609
 610 (defun mairix-widget-make-query-from-widgets (widgets)
 611   "Create mairix query from widget values WIDGETS."
 612   (let (query temp flag)
 613     ;; first we do the editable fields
 614     (dolist (cur mairix-widget-fields-list)
 615       ;; See if checkbox is checked
 616       (when (widget-value
 617              (cadr (assoc (concat "c" (car (cddr cur))) widgets)))
 618         ;; create query for the field
 619         (push
 620          (concat
 621           (nth 1 cur)
 622           ":"
 623           (mairix-replace-illegal-chars
 624            (widget-value
 625            (cadr (assoc (concat "e" (car (cddr cur))) widgets)))))
 626          query)))
 627     ;; Flags
 628     (when (member 'flags mairix-widget-other)
 629       (setq flag
 630             (mapconcat
 631              (function
 632               (lambda (flag)
 633                 (setq temp
 634                       (widget-value (cadr (assoc (car flag) mairix-widgets))))
 635                 (if (string= "yes" temp)
 636                     (cadr flag)
 637                   (if (string= "no" temp)
 638                       (concat "-" (cadr flag))))))
 639              '(("seen" "s") ("replied" "r") ("flagged" "f")) ""))
 640       (when (not (zerop (length flag)))
 641         (push (concat "F:" flag) query)))
 642     ;; return query string
 643     (mapconcat 'identity query " ")))
 644
 645 (defun mairix-widget-create-query (&optional values)
 646   "Create widgets for creating mairix queries.
 647 Fill in VALUES if based on an article."
 648   (let (allwidgets)
 649     (when (get-buffer mairix-customize-query-buffer)
 650       (kill-buffer mairix-customize-query-buffer))
 651     (switch-to-buffer mairix-customize-query-buffer)
 652     (kill-all-local-variables)
 653     (erase-buffer)
 654     (widget-insert
 655      "Specify your query for Mairix (check boxes for activating fields):\n\n")
 656     (widget-insert
 657      "(Whitespaces will be converted to ',' (i.e. AND). Use '/' for OR.)\n\n")
 658     (setq mairix-widgets (mairix-widget-build-editable-fields values))
 659     (when (member 'flags mairix-widget-other)
 660       (widget-insert "\nFlags:\n      Seen:     ")
 661       (mairix-widget-add "seen"
 662                            'menu-choice
 663                            :value "ignore"
 664                            '(item "yes") '(item "no") '(item "ignore"))
 665       (widget-insert "      Replied:  ")
 666       (mairix-widget-add "replied"
 667                            'menu-choice
 668                            :value "ignore"
 669                            '(item "yes") '(item "no") '(item "ignore"))
 670       (widget-insert "      Ticked:   ")
 671       (mairix-widget-add "flagged"
 672                            'menu-choice
 673                            :value "ignore"
 674                            '(item "yes") '(item "no") '(item "ignore")))
 675     (when (member 'threads mairix-widget-other)
 676       (widget-insert "\n")
 677       (mairix-widget-add "Threads" 'checkbox nil))
 678       (widget-insert " Show full threads\n\n")))
 679
 680 (defun mairix-widget-build-editable-fields (values)
 681   "Build editable field widgets in `nnmairix-widget-fields-list'.
 682 VALUES may contain values for editable fields from current article."
 683   (let ((ret))
 684     (mapc
 685      (function
 686       (lambda (field)
 687         (setq field (car (cddr field)))
 688         (setq
 689          ret
 690          (nconc
 691           (list
 692            (list
 693             (concat "c" field)
 694             (widget-create 'checkbox
 695                            :tag field
 696                            :notify (lambda (widget &rest ignore)
 697                                      (mairix-widget-toggle-activate widget))
 698                            nil)))
 699           (list
 700            (list
 701             (concat "e" field)
 702             (widget-create 'editable-field
 703                            :size 60
 704                            :format (concat " " field ":"
 705                                            (make-string
 706                                             (- 11 (length field)) ?\ )
 707                                            "%v")
 708                            :value (or (cadr (assoc field values)) ""))))
 709           ret))
 710         (widget-insert "\n")
 711         ;; Deactivate editable field
 712         (widget-apply (cadr (nth 1 ret)) :deactivate)))
 713      mairix-widget-fields-list)
 714     ret))
 715
 716 (defun mairix-widget-add (name &rest args)
 717   "Add a widget NAME with optional ARGS."
 718   (push
 719    (list name
 720          (apply 'widget-create args))
 721    mairix-widgets))
 722
 723 (defun mairix-widget-toggle-activate (widget)
 724   "Toggle activation status of WIDGET depending on checkbox value."
 725   (let ((field (widget-get widget :tag)))
 726     (if (widget-value widget)
 727         (widget-apply
 728          (cadr (assoc (concat "e" field) mairix-widgets))
 729          :activate)
 730       (widget-apply
 731        (cadr (assoc (concat "e" field) mairix-widgets))
 732        :deactivate)))
 733   (widget-setup))
 734
 735
 736 ;;;; Major mode for editing/deleting/saving searches
 737
 738 (defvar mairix-searches-mode-map
 739   (let ((map (make-keymap)))
 740     (define-key map [(return)] 'mairix-select-search)
 741     (define-key map [(down)] 'mairix-next-search)
 742     (define-key map [(up)] 'mairix-previous-search)
 743     (define-key map [(right)] 'mairix-next-search)
 744     (define-key map [(left)] 'mairix-previous-search)
 745     (define-key map "\C-p" 'mairix-previous-search)
 746     (define-key map "\C-n" 'mairix-next-search)
 747     (define-key map [(q)] 'mairix-select-quit)
 748     (define-key map [(e)] 'mairix-select-edit)
 749     (define-key map [(d)] 'mairix-select-delete)
 750     (define-key map [(s)] 'mairix-select-save)
 751     map)
 752   "'mairix-searches-mode' keymap.")
 753
 754 (defvar mairix-searches-mode-font-lock-keywords)
 755
 756 (defun mairix-searches-mode ()
 757   "Major mode for editing mairix searches."
 758   (interactive)
 759   (kill-all-local-variables)
 760   (setq major-mode 'mairix-searches-mode)
 761   (setq mode-name "mairix-searches")
 762   (set-syntax-table text-mode-syntax-table)
 763   (use-local-map mairix-searches-mode-map)
 764   (make-local-variable 'font-lock-defaults)
 765   (setq mairix-searches-mode-font-lock-keywords
 766         (list (list "^\\([0-9]+\\)"
 767                     '(1 font-lock-constant-face))
 768               (list "^[0-9 ]+\\(Name:\\) \\(.*\\)"
 769                     '(1 font-lock-keyword-face) '(2 font-lock-string-face))
 770               (list "^[ ]+\\(Query:\\) \\(.*\\) , "
 771                     '(1 font-lock-keyword-face) '(2 font-lock-string-face))
 772               (list ", \\(Threads:\\) \\(.*\\)"
 773                     '(1 font-lock-keyword-face) '(2 font-lock-constant-face))
 774               (list "^\\([A-Z].*\\)$"
 775                     '(1 font-lock-comment-face))
 776               (list "^[ ]+\\(Folder:\\) \\(.*\\)"
 777                     '(1 font-lock-keyword-face) '(2 font-lock-string-face))))
 778   (setq font-lock-defaults '(mairix-searches-mode-font-lock-keywords)))
 779
 780 (defun mairix-build-search-list ()
 781   "Display saved searches in current buffer."
 782   (insert "These are your current saved mairix searches.\n\
 783 You may use the following keys in this buffer: \n\
 784 Return: execute search, e: edit, d: delete, s: save, q: quit\n\
 785 Use cursor keys or C-n,C-p to select next/previous search.\n\n")
 786   (let ((num 0)
 787         (beg (point))
 788         current)
 789     (while (< num (length mairix-saved-searches))
 790       (setq current (nth num mairix-saved-searches))
 791       (setq num (1+ num))
 792       (mairix-insert-search-line num current)
 793       (insert "\n"))
 794     (goto-char beg)))
 795
 796 (defun mairix-insert-search-line (number field)
 797   "Insert new mairix query with NUMBER and values FIELD in buffer."
 798   (insert
 799    (format "%d Name: %s\n   Query: %s , Threads: %s\n   Folder: %s\n"
 800            number
 801            (car field)
 802            (nth 1 field)
 803            (if (nth 3 field)
 804                "Yes"
 805              "No")
 806            (if (nth 2 field)
 807                (nth 2 field)
 808              "Default"))))
 809
 810 (defun mairix-select-search ()
 811   "Call mairix with currently selected search."
 812   (interactive)
 813   (beginning-of-line)
 814   (if (not (looking-at "[0-9]+ Name"))
 815       (progn
 816         (ding)
 817         (message "Put cursor on a line with a search name first"))
 818     (progn
 819       (let* ((query (nth
 820                     (1- (read (current-buffer)))
 821                     mairix-saved-searches))
 822             (folder (nth 2 query)))
 823         (when (not folder)
 824           (setq folder mairix-search-file))
 825         (mairix-call-mairix
 826          (split-string (nth 1 query))
 827          folder
 828          (car (last query)))
 829         (mairix-select-quit)
 830         (mairix-show-folder folder)))))
 831
 832 (defun mairix-next-search ()
 833   "Jump to next search."
 834   (interactive)
 835   (if (search-forward-regexp "^[0-9]+"
 836                              (point-max)
 837                              t
 838                              2)
 839       (beginning-of-line)
 840     (ding)))
 841
 842 (defun mairix-previous-search ()
 843   "Jump to previous search."
 844   (interactive)
 845   (if (search-backward-regexp "^[0-9]+"
 846                              (point-min)
 847                              t)
 848       (beginning-of-line)
 849     (ding)))
 850
 851 (defun mairix-select-quit ()
 852   "Quit mairix search mode."
 853   (interactive)
 854   (when mairix-searches-changed
 855     (mairix-select-save))
 856   (kill-buffer nil))
 857
 858 (defun mairix-select-save ()
 859   "Save current mairix searches."
 860   (interactive)
 861   (when (y-or-n-p "Save mairix searches permanently in your .emacs? ")
 862     (customize-save-variable 'mairix-saved-searches mairix-saved-searches)))
 863
 864 (defun mairix-select-edit ()
 865   "Edit currently selected mairix search."
 866   (interactive)
 867   (beginning-of-line)
 868   (if (not (looking-at "[0-9]+ Name"))
 869       (error "Put cursor on a line with a search name first")
 870     (progn
 871       (let* ((number (1- (read (current-buffer))))
 872              (query (nth number mairix-saved-searches))
 873              (folder (nth 2 query))
 874              newname newquery newfolder threads)
 875         (backward-char)
 876         (setq newname (read-string "Name of the search: " (car query)))
 877         (when (assoc newname (remq (nth number mairix-saved-searches)
 878                                    mairix-saved-searches))
 879           (error "This name does already exist"))
 880         (setq newquery (read-string "Query: " (nth 1 query)))
 881         (setq threads (y-or-n-p "Include whole threads? "))
 882         (setq newfolder
 883               (read-string "Mail folder (use empty string for default): "
 884                            folder))
 885         (when (zerop (length newfolder))
 886           (setq newfolder nil))
 887         ;; set new values
 888         (setcar (nth number mairix-saved-searches) newname)
 889         (setcdr (nth number mairix-saved-searches)
 890                 (list newquery newfolder threads))
 891         (setq mairix-searches-changed t)
 892         (let ((beg (point)))
 893           (forward-line 3)
 894           (end-of-line)
 895           (delete-region beg (point))
 896           (mairix-insert-search-line (1+ number)
 897                                      (nth number mairix-saved-searches))
 898           (goto-char beg))))))
 899
 900 (defun mairix-select-delete ()
 901   "Delete currently selected mairix search."
 902   (interactive)
 903   (if (not (looking-at "[0-9]+ Name"))
 904       (error "Put cursor on a line with a search name first")
 905     (progn
 906       (let* ((number (1- (read (current-buffer))))
 907              (query (nth number mairix-saved-searches))
 908              beg)
 909         (backward-char)
 910         (when (y-or-n-p (format "Delete search %s ? " (car query)))
 911           (setq mairix-saved-searches
 912                 (delq query mairix-saved-searches))
 913           (setq mairix-searches-changed t)
 914           (setq beg (point))
 915           (forward-line 4)
 916           (beginning-of-line)
 917           (delete-region beg (point))
 918           (while (search-forward-regexp "^[0-9]+"
 919                                         (point-max)
 920                                         t
 921                                         1)
 922             (replace-match (number-to-string
 923                             (setq number (1+ number)))))))
 924       (beginning-of-line))))
 925
 926 (defun mairix-widget-get-values ()
 927   "Create values for editable fields from current article."
 928   (let ((get-mail-header
 929          (cadr (assq mairix-mail-program mairix-get-mail-header-functions))))
 930     (if get-mail-header
 931         (save-excursion
 932           (save-restriction
 933             (mapcar
 934              (function
 935               (lambda (field)
 936                 (list (car (cddr field))
 937                       (if (car field)
 938                           (mairix-replace-illegal-chars
 939                            (funcall get-mail-header (car field)))
 940                         nil))))
 941              mairix-widget-fields-list)))
 942       (error "No function for obtaining mail header specified"))))
 943
 944
 945 (provide 'mairix)
 946
 947 ;;; mairix.el ends here