lisp/net/mairix.el

   1 ;;; mairix.el --- Mairix interface for Emacs
   2
   3 ;; Copyright (C) 2008, 2009  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 favourite 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     (save-excursion
 264       (set-buffer rmail-buffer)
 265       (save-restriction
 266         ;; Don't warn about this when compiling Emacs 23.
 267         (with-no-warnings (rmail-narrow-to-non-pruned-header))
 268         (mail-fetch-field field)))))
 269
 270 ;;; Gnus
 271 (eval-when-compile
 272   (defvar gnus-article-buffer)
 273   (autoload 'gnus-summary-toggle-header "gnus-sum")
 274   (autoload 'gnus-buffer-exists-p "gnus-util")
 275   (autoload 'message-field-value "message")
 276   (autoload 'gnus-group-read-ephemeral-group "gnus-group")
 277   (autoload 'gnus-alive-p "gnus-util"))
 278
 279 ;; Display function:
 280 (defun mairix-gnus-ephemeral-nndoc (folder)
 281   "Create ephemeral nndoc group for reading mbox file FOLDER in Gnus."
 282   (unless (gnus-alive-p)
 283     (error "Gnus is not running"))
 284   (gnus-group-read-ephemeral-group
 285    ;; add randomness to group string to prevent Gnus from using a
 286    ;; cached version
 287    (format "mairix.%s" (number-to-string (random 10000)))
 288    `(nndoc "mairix"
 289            (nndoc-address ,folder)
 290            (nndoc-article-type mbox))))
 291
 292 ;; Fetching mail header field:
 293 (defun mairix-gnus-fetch-field (field)
 294   "Get mail header FIELD for current message using Gnus."
 295   (unless (gnus-alive-p)
 296     (error "Gnus is not running"))
 297   (save-excursion
 298     (unless (gnus-buffer-exists-p gnus-article-buffer)
 299       (error "No article buffer available"))
 300     (set-buffer gnus-article-buffer)
 301     (gnus-summary-toggle-header 1)
 302     (message-field-value field)))
 303
 304 ;;; VM
 305 ;;; written by Ulrich Mueller
 306
 307 (eval-when-compile
 308   (autoload 'vm-quit "vm-folder")
 309   (autoload 'vm-visit-folder "vm")
 310   (autoload 'vm-select-folder-buffer "vm-macro")
 311   (autoload 'vm-check-for-killed-summary "vm-misc")
 312   (autoload 'vm-get-header-contents "vm-summary")
 313   (autoload 'vm-check-for-killed-summary "vm-misc")
 314   (autoload 'vm-error-if-folder-empty "vm-misc")
 315   (autoload 'vm-select-marked-or-prefixed-messages "vm-folder"))
 316
 317 ;; Display function
 318 (defun mairix-vm-display (folder)
 319   "Display mbox file FOLDER with VM."
 320   (require 'vm)
 321   ;; check if folder is already open and if so, kill it
 322   (let ((buf (get-file-buffer folder)))
 323     (when buf
 324       (set-buffer buf)
 325       (set-buffer-modified-p nil)
 326       (condition-case nil
 327           (vm-quit t)
 328         (error nil))
 329       (kill-buffer buf)))
 330   (vm-visit-folder folder t))
 331
 332 ;; Fetching mail header field
 333 (defun mairix-vm-fetch-field (field)
 334   "Get mail header FIELD for current message using VM."
 335   (save-excursion
 336     (vm-select-folder-buffer)
 337     (vm-check-for-killed-summary)
 338     (vm-error-if-folder-empty)
 339     (vm-get-header-contents
 340      (car (vm-select-marked-or-prefixed-messages 1)) field)))
 341
 342 ;;;; Main interactive functions
 343
 344 (defun mairix-search (search threads)
 345   "Call Mairix with SEARCH.
 346 If THREADS is t, also display whole threads of found
 347 messages.  Results will be put into the default search file."
 348   (interactive
 349    (list
 350     (read-string "Query: ")
 351     (y-or-n-p "Include threads? ")))
 352   (when (mairix-call-mairix
 353          (split-string search)
 354          nil
 355          threads)
 356     (mairix-show-folder mairix-search-file)))
 357
 358 (defun mairix-use-saved-search ()
 359   "Use a saved search for querying Mairix."
 360   (interactive)
 361   (let* ((completions
 362           (mapcar (lambda (el) (list (car el))) mairix-saved-searches))
 363          (search (completing-read "Name of search: " completions))
 364          (query (assoc search mairix-saved-searches))
 365          (folder (nth 2 query)))
 366     (when (not folder)
 367       (setq folder mairix-search-file))
 368     (when query
 369       (mairix-call-mairix
 370        (split-string (nth 1 query))
 371        folder
 372        (car (last query)))
 373       (mairix-show-folder folder))))
 374
 375 (defun mairix-save-search ()
 376   "Save the last search."
 377   (interactive)
 378   (let* ((name (read-string "Name of the search: "))
 379          (exist (assoc name mairix-saved-searches)))
 380     (if (not exist)
 381         (add-to-list 'mairix-saved-searches
 382                      (append (list name) mairix-last-search))
 383       (when
 384           (y-or-n-p
 385            "There is already a search with this name.  \
 386 Overwrite existing entry? ")
 387         (setcdr (assoc name mairix-saved-searches) mairix-last-search))))
 388   (mairix-select-save))
 389
 390 (defun mairix-edit-saved-searches-customize ()
 391   "Edit the list of saved searches in a customization buffer."
 392   (interactive)
 393   (custom-buffer-create (list (list 'mairix-saved-searches 'custom-variable))
 394                         "*Customize Mairix Query*"
 395                                 (concat "\n\n" (make-string 65 ?=)
 396 "\nYou can now customize your saved Mairix searches by modifying\n\
 397 the variable mairix-saved-searches. Don't forget to save your\nchanges \
 398 in your .emacs by pressing 'Save for Future Sessions'.\n"
 399 (make-string 65 ?=) "\n")))
 400
 401 (autoload 'mail-strip-quoted-names "mail-utils")
 402 (defun mairix-search-from-this-article (threads)
 403   "Search messages from sender of the current article.
 404 This is effectively a shortcut for calling `mairix-search' with
 405 f:current_from.  If prefix THREADS is non-nil, include whole
 406 threads."
 407   (interactive "P")
 408   (let ((get-mail-header
 409          (cadr (assq mairix-mail-program mairix-get-mail-header-functions))))
 410     (if get-mail-header
 411         (mairix-search
 412          (format "f:%s"
 413                  (mail-strip-quoted-names
 414                   (funcall get-mail-header "from")))
 415          threads)
 416       (error "No function for obtaining mail header specified"))))
 417
 418 (defun mairix-search-thread-this-article ()
 419   "Search thread for the current article.
 420 This is effectively a shortcut for calling `mairix-search'
 421 with m:msgid of the current article and enabled threads."
 422   (interactive)
 423   (let ((get-mail-header
 424          (cadr (assq mairix-mail-program mairix-get-mail-header-functions)))
 425         mid)
 426     (unless get-mail-header
 427       (error "No function for obtaining mail header specified"))
 428     (setq mid (funcall get-mail-header "message-id"))
 429     (while (string-match "[<>]" mid)
 430       (setq mid (replace-match "" t t mid)))
 431     ;; mairix somehow does not like '$' in message-id
 432     (when (string-match "\\$" mid)
 433       (setq mid (concat mid "=")))
 434     (while (string-match "\\$" mid)
 435       (setq mid (replace-match "=," t t mid)))
 436     (mairix-search
 437      (format "m:%s" mid) t)))
 438
 439 (defun mairix-widget-search-based-on-article ()
 440   "Create mairix query based on current article using widgets."
 441   (interactive)
 442   (mairix-widget-search
 443    (mairix-widget-get-values)))
 444
 445 (defun mairix-edit-saved-searches ()
 446   "Edit current mairix searches."
 447   (interactive)
 448   (switch-to-buffer mairix-saved-searches-buffer)
 449   (erase-buffer)
 450   (setq mairix-searches-changed nil)
 451   (mairix-build-search-list)
 452   (mairix-searches-mode)
 453   (hl-line-mode))
 454
 455 (defvar mairix-widgets)
 456
 457 (defun mairix-widget-search (&optional mvalues)
 458   "Create mairix query interactively using graphical widgets.
 459 MVALUES may contain values from current article."
 460   (interactive)
 461   ;; Select window for mairix customization
 462   (funcall mairix-widget-select-window-function)
 463   ;; generate widgets
 464   (mairix-widget-create-query mvalues)
 465   ;; generate Buttons
 466   (widget-create 'push-button
 467                  :notify
 468                  (lambda (&rest ignore)
 469                    (mairix-widget-send-query mairix-widgets))
 470                  "Send Query")
 471   (widget-insert "   ")
 472   (widget-create 'push-button
 473                  :notify
 474                  (lambda (&rest ignore)
 475                    (mairix-widget-save-search mairix-widgets))
 476                  "Save search")
 477   (widget-insert "   ")
 478   (widget-create 'push-button
 479                  :notify (lambda (&rest ignore)
 480                            (kill-buffer mairix-customize-query-buffer))
 481                  "Cancel")
 482   (use-local-map widget-keymap)
 483   (widget-setup)
 484   (goto-char (point-min)))
 485
 486 (defun mairix-update-database ()
 487   "Call mairix for updating the database for SERVERS.
 488 Mairix will be called asynchronously unless
 489 `mairix-synchronous-update' is t.  Mairix will be called with
 490 `mairix-update-options'."
 491   (interactive)
 492   (let ((commandsplit (split-string mairix-command))
 493         args)
 494     (if mairix-synchronous-update
 495         (progn
 496           (setq args (append (list (car commandsplit) nil
 497                                    (get-buffer-create mairix-output-buffer)
 498                                    nil)))
 499           (if (> (length commandsplit) 1)
 500               (setq args (append args
 501                                  (cdr commandsplit)
 502                                  mairix-update-options))
 503             (setq args (append args mairix-update-options)))
 504           (apply 'call-process args))
 505       (progn
 506         (message "Updating mairix database...")
 507         (setq args (append (list "mairixupdate" (get-buffer-create mairix-output-buffer)
 508                                  (car commandsplit))))
 509         (if (> (length commandsplit) 1)
 510             (setq args (append args (cdr commandsplit) mairix-update-options))
 511           (setq args (append args mairix-update-options)))
 512         (set-process-sentinel
 513          (apply 'start-process args)
 514          'mairix-sentinel-mairix-update-finished)))))
 515
 516
 517 ;;;; Helper functions
 518
 519 (defun mairix-show-folder (folder)
 520   "Display mail FOLDER with mail program.
 521 The mail program is given by `mairix-mail-program'."
 522   (let ((display-function
 523          (cadr (assq mairix-mail-program mairix-display-functions))))
 524     (if display-function
 525         (funcall display-function
 526                  (concat
 527                   (file-name-as-directory
 528                    (expand-file-name mairix-file-path))
 529                   folder))
 530       (error "No mail program set"))))
 531
 532 (defun mairix-call-mairix (query file threads)
 533   "Call Mairix with QUERY and output FILE.
 534 If FILE is nil, use default.  If THREADS is non-nil, also return
 535 whole threads.  Function returns t if messages were found."
 536   (let* ((commandsplit (split-string mairix-command))
 537          (args (cons (car commandsplit)
 538                      `(nil ,(get-buffer-create mairix-output-buffer) nil)))
 539          rval)
 540     (with-current-buffer mairix-output-buffer
 541       (erase-buffer))
 542     (when (> (length commandsplit) 1)
 543       (setq args (append args (cdr commandsplit))))
 544     (when threads
 545       (setq args (append args '("-t"))))
 546     (when (stringp query)
 547       (setq query (split-string query)))
 548     (setq mairix-last-search (list (mapconcat 'identity query " ")
 549                                      file threads))
 550     (when (not file)
 551       (setq file mairix-search-file))
 552     (setq file
 553           (concat
 554            (file-name-as-directory
 555             (expand-file-name
 556              mairix-file-path))
 557            file))
 558     (setq rval
 559           (apply 'call-process
 560                  (append args (list "-o" file) query)))
 561     (if (zerop rval)
 562         (with-current-buffer mairix-output-buffer
 563           (goto-char (point-min))
 564           (re-search-forward "^Matched.*messages")
 565           (message (match-string 0)))
 566       (if (and (= rval 1)
 567                (with-current-buffer mairix-output-buffer
 568                  (goto-char (point-min))
 569                  (looking-at "^Matched 0 messages")))
 570           (message "No messages found")
 571         (error "Error running Mairix.  See buffer %s for details"
 572                mairix-output-buffer)))
 573     (zerop rval)))
 574
 575 (defun mairix-replace-illegal-chars (header)
 576   "Replace illegal characters in HEADER for mairix query."
 577   (when header
 578     (while (string-match "[^-.@/,& [:alnum:]]" header)
 579       (setq header (replace-match "" t t header)))
 580     (while (string-match "[& ]" header)
 581       (setq header (replace-match "," t t header)))
 582   header))
 583
 584 (defun mairix-sentinel-mairix-update-finished (proc status)
 585   "Sentinel for mairix update process PROC with STATUS."
 586   (if (equal status "finished\n")
 587       (message "Updating mairix database... done")
 588     (error "There was an error updating the mairix database.  \
 589 See %s for details" mairix-output-buffer)))
 590
 591
 592 ;;;; Widget stuff
 593
 594
 595
 596 (defun mairix-widget-send-query (widgets)
 597   "Send query from WIDGETS to mairix binary."
 598   (mairix-search
 599    (mairix-widget-make-query-from-widgets widgets)
 600    (if (widget-value (cadr (assoc "Threads" widgets)))
 601        t
 602      -1))
 603   (kill-buffer mairix-customize-query-buffer))
 604
 605 (defun mairix-widget-save-search (widgets)
 606   "Save search based on WIDGETS for future use."
 607   (let ((mairix-last-search
 608          `( ,(mairix-widget-make-query-from-widgets widgets)
 609             nil
 610             ,(widget-value (cadr (assoc "Threads" widgets))))))
 611         (mairix-save-search)
 612         (kill-buffer mairix-customize-query-buffer)))
 613
 614 (defun mairix-widget-make-query-from-widgets (widgets)
 615   "Create mairix query from widget values WIDGETS."
 616   (let (query temp flag)
 617     ;; first we do the editable fields
 618     (dolist (cur mairix-widget-fields-list)
 619       ;; See if checkbox is checked
 620       (when (widget-value
 621              (cadr (assoc (concat "c" (car (cddr cur))) widgets)))
 622         ;; create query for the field
 623         (push
 624          (concat
 625           (nth 1 cur)
 626           ":"
 627           (mairix-replace-illegal-chars
 628            (widget-value
 629            (cadr (assoc (concat "e" (car (cddr cur))) widgets)))))
 630          query)))
 631     ;; Flags
 632     (when (member 'flags mairix-widget-other)
 633       (setq flag
 634             (mapconcat
 635              (function
 636               (lambda (flag)
 637                 (setq temp
 638                       (widget-value (cadr (assoc (car flag) mairix-widgets))))
 639                 (if (string= "yes" temp)
 640                     (cadr flag)
 641                   (if (string= "no" temp)
 642                       (concat "-" (cadr flag))))))
 643              '(("seen" "s") ("replied" "r") ("flagged" "f")) ""))
 644       (when (not (zerop (length flag)))
 645         (push (concat "F:" flag) query)))
 646     ;; return query string
 647     (mapconcat 'identity query " ")))
 648
 649 (defun mairix-widget-create-query (&optional values)
 650   "Create widgets for creating mairix queries.
 651 Fill in VALUES if based on an article."
 652   (let (allwidgets)
 653     (when (get-buffer mairix-customize-query-buffer)
 654       (kill-buffer mairix-customize-query-buffer))
 655     (switch-to-buffer mairix-customize-query-buffer)
 656     (kill-all-local-variables)
 657     (erase-buffer)
 658     (widget-insert
 659      "Specify your query for Mairix (check boxes for activating fields):\n\n")
 660     (widget-insert
 661      "(Whitespaces will be converted to ',' (i.e. AND). Use '/' for OR.)\n\n")
 662     (setq mairix-widgets (mairix-widget-build-editable-fields values))
 663     (when (member 'flags mairix-widget-other)
 664       (widget-insert "\nFlags:\n      Seen:     ")
 665       (mairix-widget-add "seen"
 666                            'menu-choice
 667                            :value "ignore"
 668                            '(item "yes") '(item "no") '(item "ignore"))
 669       (widget-insert "      Replied:  ")
 670       (mairix-widget-add "replied"
 671                            'menu-choice
 672                            :value "ignore"
 673                            '(item "yes") '(item "no") '(item "ignore"))
 674       (widget-insert "      Ticked:   ")
 675       (mairix-widget-add "flagged"
 676                            'menu-choice
 677                            :value "ignore"
 678                            '(item "yes") '(item "no") '(item "ignore")))
 679     (when (member 'threads mairix-widget-other)
 680       (widget-insert "\n")
 681       (mairix-widget-add "Threads" 'checkbox nil))
 682       (widget-insert " Show full threads\n\n")))
 683
 684 (defun mairix-widget-build-editable-fields (values)
 685   "Build editable field widgets in `nnmairix-widget-fields-list'.
 686 VALUES may contain values for editable fields from current article."
 687   (let ((ret))
 688     (mapc
 689      (function
 690       (lambda (field)
 691         (setq field (car (cddr field)))
 692         (setq
 693          ret
 694          (nconc
 695           (list
 696            (list
 697             (concat "c" field)
 698             (widget-create 'checkbox
 699                            :tag field
 700                            :notify (lambda (widget &rest ignore)
 701                                      (mairix-widget-toggle-activate widget))
 702                            nil)))
 703           (list
 704            (list
 705             (concat "e" field)
 706             (widget-create 'editable-field
 707                            :size 60
 708                            :format (concat " " field ":"
 709                                            (make-string
 710                                             (- 11 (length field)) ?\ )
 711                                            "%v")
 712                            :value (or (cadr (assoc field values)) ""))))
 713           ret))
 714         (widget-insert "\n")
 715         ;; Deactivate editable field
 716         (widget-apply (cadr (nth 1 ret)) :deactivate)))
 717      mairix-widget-fields-list)
 718     ret))
 719
 720 (defun mairix-widget-add (name &rest args)
 721   "Add a widget NAME with optional ARGS."
 722   (push
 723    (list name
 724          (apply 'widget-create args))
 725    mairix-widgets))
 726
 727 (defun mairix-widget-toggle-activate (widget)
 728   "Toggle activation status of WIDGET depending on checkbox value."
 729   (let ((field (widget-get widget :tag)))
 730     (if (widget-value widget)
 731         (widget-apply
 732          (cadr (assoc (concat "e" field) mairix-widgets))
 733          :activate)
 734       (widget-apply
 735        (cadr (assoc (concat "e" field) mairix-widgets))
 736        :deactivate)))
 737   (widget-setup))
 738
 739
 740 ;;;; Major mode for editing/deleting/saving searches
 741
 742 (defvar mairix-searches-mode-map nil "'mairix-searches-mode' keymap.")
 743
 744 ;; Keymap
 745 (if (not mairix-searches-mode-map)
 746     (let ((map (make-keymap)))
 747       (define-key map [(return)] 'mairix-select-search)
 748       (define-key map [(down)] 'mairix-next-search)
 749       (define-key map [(up)] 'mairix-previous-search)
 750       (define-key map [(right)] 'mairix-next-search)
 751       (define-key map [(left)] 'mairix-previous-search)
 752       (define-key map "\C-p" 'mairix-previous-search)
 753       (define-key map "\C-n" 'mairix-next-search)
 754       (define-key map [(q)] 'mairix-select-quit)
 755       (define-key map [(e)] 'mairix-select-edit)
 756       (define-key map [(d)] 'mairix-select-delete)
 757       (define-key map [(s)] 'mairix-select-save)
 758       (setq mairix-searches-mode-map map)))
 759
 760 (defvar mairix-searches-mode-font-lock-keywords)
 761
 762 (defun mairix-searches-mode ()
 763   "Major mode for editing mairix searches."
 764   (interactive)
 765   (kill-all-local-variables)
 766   (setq major-mode 'mairix-searches-mode)
 767   (setq mode-name "mairix-searches")
 768   (set-syntax-table text-mode-syntax-table)
 769   (use-local-map mairix-searches-mode-map)
 770   (make-local-variable 'font-lock-defaults)
 771   (setq mairix-searches-mode-font-lock-keywords
 772         (list (list "^\\([0-9]+\\)"
 773                     '(1 font-lock-constant-face))
 774               (list "^[0-9 ]+\\(Name:\\) \\(.*\\)"
 775                     '(1 font-lock-keyword-face) '(2 font-lock-string-face))
 776               (list "^[ ]+\\(Query:\\) \\(.*\\) , "
 777                     '(1 font-lock-keyword-face) '(2 font-lock-string-face))
 778               (list ", \\(Threads:\\) \\(.*\\)"
 779                     '(1 font-lock-keyword-face) '(2 font-lock-constant-face))
 780               (list "^\\([A-Z].*\\)$"
 781                     '(1 font-lock-comment-face))
 782               (list "^[ ]+\\(Folder:\\) \\(.*\\)"
 783                     '(1 font-lock-keyword-face) '(2 font-lock-string-face))))
 784   (setq font-lock-defaults '(mairix-searches-mode-font-lock-keywords)))
 785
 786 (defun mairix-build-search-list ()
 787   "Display saved searches in current buffer."
 788   (insert "These are your current saved mairix searches.\n\
 789 You may use the following keys in this buffer: \n\
 790 Return: execute search, e: edit, d: delete, s: save, q: quit\n\
 791 Use cursor keys or C-n,C-p to select next/previous search.\n\n")
 792   (let ((num 0)
 793         (beg (point))
 794         current)
 795     (while (< num (length mairix-saved-searches))
 796       (setq current (nth num mairix-saved-searches))
 797       (setq num (1+ num))
 798       (mairix-insert-search-line num current)
 799       (insert "\n"))
 800     (goto-char beg)))
 801
 802 (defun mairix-insert-search-line (number field)
 803   "Insert new mairix query with NUMBER and values FIELD in buffer."
 804   (insert
 805    (format "%d Name: %s\n   Query: %s , Threads: %s\n   Folder: %s\n"
 806            number
 807            (car field)
 808            (nth 1 field)
 809            (if (nth 3 field)
 810                "Yes"
 811              "No")
 812            (if (nth 2 field)
 813                (nth 2 field)
 814              "Default"))))
 815
 816 (defun mairix-select-search ()
 817   "Call mairix with currently selected search."
 818   (interactive)
 819   (beginning-of-line)
 820   (if (not (looking-at "[0-9]+ Name"))
 821       (progn
 822         (ding)
 823         (message "Put cursor on a line with a search name first"))
 824     (progn
 825       (let* ((query (nth
 826                     (1- (read (current-buffer)))
 827                     mairix-saved-searches))
 828             (folder (nth 2 query)))
 829         (when (not folder)
 830           (setq folder mairix-search-file))
 831         (mairix-call-mairix
 832          (split-string (nth 1 query))
 833          folder
 834          (car (last query)))
 835         (mairix-select-quit)
 836         (mairix-show-folder folder)))))
 837
 838 (defun mairix-next-search ()
 839   "Jump to next search."
 840   (interactive)
 841   (if (search-forward-regexp "^[0-9]+"
 842                              (point-max)
 843                              t
 844                              2)
 845       (beginning-of-line)
 846     (ding)))
 847
 848 (defun mairix-previous-search ()
 849   "Jump to previous search."
 850   (interactive)
 851   (if (search-backward-regexp "^[0-9]+"
 852                              (point-min)
 853                              t)
 854       (beginning-of-line)
 855     (ding)))
 856
 857 (defun mairix-select-quit ()
 858   "Quit mairix search mode."
 859   (interactive)
 860   (when mairix-searches-changed
 861     (mairix-select-save))
 862   (kill-buffer nil))
 863
 864 (defun mairix-select-save ()
 865   "Save current mairix searches."
 866   (interactive)
 867   (when (y-or-n-p "Save mairix searches permanently in your .emacs? ")
 868     (customize-save-variable 'mairix-saved-searches mairix-saved-searches)))
 869
 870 (defun mairix-select-edit ()
 871   "Edit currently selected mairix search."
 872   (interactive)
 873   (beginning-of-line)
 874   (if (not (looking-at "[0-9]+ Name"))
 875       (error "Put cursor on a line with a search name first")
 876     (progn
 877       (let* ((number (1- (read (current-buffer))))
 878              (query (nth number mairix-saved-searches))
 879              (folder (nth 2 query))
 880              newname newquery newfolder threads)
 881         (backward-char)
 882         (setq newname (read-string "Name of the search: " (car query)))
 883         (when (assoc newname (remq (nth number mairix-saved-searches)
 884                                    mairix-saved-searches))
 885           (error "This name does already exist"))
 886         (setq newquery (read-string "Query: " (nth 1 query)))
 887         (setq threads (y-or-n-p "Include whole threads? "))
 888         (setq newfolder
 889               (read-string "Mail folder (use empty string for default): "
 890                            folder))
 891         (when (zerop (length newfolder))
 892           (setq newfolder nil))
 893         ;; set new values
 894         (setcar (nth number mairix-saved-searches) newname)
 895         (setcdr (nth number mairix-saved-searches)
 896                 (list newquery newfolder threads))
 897         (setq mairix-searches-changed t)
 898         (let ((beg (point)))
 899           (forward-line 3)
 900           (end-of-line)
 901           (delete-region beg (point))
 902           (mairix-insert-search-line (1+ number)
 903                                      (nth number mairix-saved-searches))
 904           (goto-char beg))))))
 905
 906 (defun mairix-select-delete ()
 907   "Delete currently selected mairix search."
 908   (interactive)
 909   (if (not (looking-at "[0-9]+ Name"))
 910       (error "Put cursor on a line with a search name first")
 911     (progn
 912       (let* ((number (1- (read (current-buffer))))
 913              (query (nth number mairix-saved-searches))
 914              beg)
 915         (backward-char)
 916         (when (y-or-n-p (format "Delete search %s ? " (car query)))
 917           (setq mairix-saved-searches
 918                 (delq query mairix-saved-searches))
 919           (setq mairix-searches-changed t)
 920           (setq beg (point))
 921           (forward-line 4)
 922           (beginning-of-line)
 923           (delete-region beg (point))
 924           (while (search-forward-regexp "^[0-9]+"
 925                                         (point-max)
 926                                         t
 927                                         1)
 928             (replace-match (number-to-string
 929                             (setq number (1+ number)))))))
 930       (beginning-of-line))))
 931
 932 (defun mairix-widget-get-values ()
 933   "Create values for editable fields from current article."
 934   (let ((get-mail-header
 935          (cadr (assq mairix-mail-program mairix-get-mail-header-functions))))
 936     (if get-mail-header
 937         (save-excursion
 938           (save-restriction
 939             (mapcar
 940              (function
 941               (lambda (field)
 942                 (list (car (cddr field))
 943                       (if (car field)
 944                           (mairix-replace-illegal-chars
 945                            (funcall get-mail-header (car field)))
 946                         nil))))
 947              mairix-widget-fields-list)))
 948       (error "No function for obtaining mail header specified"))))
 949
 950
 951 (provide 'mairix)
 952
 953 ;;; mairix.el ends here
 954
 955 ;; arch-tag: 787ab678-fcd5-4c50-9295-01c2ee5124a6