Commit | Line | Data |
---|---|---|
8640e61c CY |
1 | ;;; mairix.el --- Mairix interface for Emacs |
2 | ||
114f9c96 | 3 | ;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. |
8640e61c CY |
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") | |
29c2869d | 204 | ("from" "a" "Address") (nil "b" "Body") (nil "n" "Attachment") |
8640e61c CY |
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") | |
c261086e | 231 | (defvar rmail-buffer) |
8640e61c CY |
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: | |
8640e61c CY |
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")) | |
c261086e GM |
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) | |
9a529312 | 263 | (with-current-buffer rmail-buffer |
c261086e GM |
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))))) | |
8640e61c CY |
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")) | |
9a529312 SM |
296 | (unless (gnus-buffer-exists-p gnus-article-buffer) |
297 | (error "No article buffer available")) | |
298 | (with-current-buffer gnus-article-buffer | |
8640e61c CY |
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 t, 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))) | |
599 | t | |
600 | -1)) | |
601 | (kill-buffer mairix-customize-query-buffer)) | |
602 | ||
603 | (defun mairix-widget-save-search (widgets) | |
604 | "Save search based on WIDGETS for future use." | |
605 | (let ((mairix-last-search | |
606 | `( ,(mairix-widget-make-query-from-widgets widgets) | |
607 | nil | |
608 | ,(widget-value (cadr (assoc "Threads" widgets)))))) | |
609 | (mairix-save-search) | |
610 | (kill-buffer mairix-customize-query-buffer))) | |
611 | ||
612 | (defun mairix-widget-make-query-from-widgets (widgets) | |
613 | "Create mairix query from widget values WIDGETS." | |
614 | (let (query temp flag) | |
615 | ;; first we do the editable fields | |
616 | (dolist (cur mairix-widget-fields-list) | |
617 | ;; See if checkbox is checked | |
618 | (when (widget-value | |
619 | (cadr (assoc (concat "c" (car (cddr cur))) widgets))) | |
620 | ;; create query for the field | |
621 | (push | |
622 | (concat | |
623 | (nth 1 cur) | |
624 | ":" | |
625 | (mairix-replace-illegal-chars | |
626 | (widget-value | |
627 | (cadr (assoc (concat "e" (car (cddr cur))) widgets))))) | |
628 | query))) | |
629 | ;; Flags | |
630 | (when (member 'flags mairix-widget-other) | |
631 | (setq flag | |
632 | (mapconcat | |
633 | (function | |
634 | (lambda (flag) | |
635 | (setq temp | |
636 | (widget-value (cadr (assoc (car flag) mairix-widgets)))) | |
637 | (if (string= "yes" temp) | |
638 | (cadr flag) | |
639 | (if (string= "no" temp) | |
640 | (concat "-" (cadr flag)))))) | |
641 | '(("seen" "s") ("replied" "r") ("flagged" "f")) "")) | |
642 | (when (not (zerop (length flag))) | |
643 | (push (concat "F:" flag) query))) | |
644 | ;; return query string | |
645 | (mapconcat 'identity query " "))) | |
646 | ||
647 | (defun mairix-widget-create-query (&optional values) | |
648 | "Create widgets for creating mairix queries. | |
649 | Fill in VALUES if based on an article." | |
650 | (let (allwidgets) | |
651 | (when (get-buffer mairix-customize-query-buffer) | |
652 | (kill-buffer mairix-customize-query-buffer)) | |
653 | (switch-to-buffer mairix-customize-query-buffer) | |
654 | (kill-all-local-variables) | |
655 | (erase-buffer) | |
656 | (widget-insert | |
657 | "Specify your query for Mairix (check boxes for activating fields):\n\n") | |
658 | (widget-insert | |
659 | "(Whitespaces will be converted to ',' (i.e. AND). Use '/' for OR.)\n\n") | |
660 | (setq mairix-widgets (mairix-widget-build-editable-fields values)) | |
661 | (when (member 'flags mairix-widget-other) | |
662 | (widget-insert "\nFlags:\n Seen: ") | |
663 | (mairix-widget-add "seen" | |
664 | 'menu-choice | |
665 | :value "ignore" | |
666 | '(item "yes") '(item "no") '(item "ignore")) | |
667 | (widget-insert " Replied: ") | |
668 | (mairix-widget-add "replied" | |
669 | 'menu-choice | |
670 | :value "ignore" | |
671 | '(item "yes") '(item "no") '(item "ignore")) | |
672 | (widget-insert " Ticked: ") | |
673 | (mairix-widget-add "flagged" | |
674 | 'menu-choice | |
675 | :value "ignore" | |
676 | '(item "yes") '(item "no") '(item "ignore"))) | |
677 | (when (member 'threads mairix-widget-other) | |
678 | (widget-insert "\n") | |
679 | (mairix-widget-add "Threads" 'checkbox nil)) | |
680 | (widget-insert " Show full threads\n\n"))) | |
681 | ||
682 | (defun mairix-widget-build-editable-fields (values) | |
683 | "Build editable field widgets in `nnmairix-widget-fields-list'. | |
684 | VALUES may contain values for editable fields from current article." | |
685 | (let ((ret)) | |
686 | (mapc | |
687 | (function | |
688 | (lambda (field) | |
689 | (setq field (car (cddr field))) | |
690 | (setq | |
691 | ret | |
692 | (nconc | |
693 | (list | |
694 | (list | |
695 | (concat "c" field) | |
696 | (widget-create 'checkbox | |
697 | :tag field | |
698 | :notify (lambda (widget &rest ignore) | |
699 | (mairix-widget-toggle-activate widget)) | |
700 | nil))) | |
701 | (list | |
702 | (list | |
703 | (concat "e" field) | |
704 | (widget-create 'editable-field | |
705 | :size 60 | |
706 | :format (concat " " field ":" | |
707 | (make-string | |
708 | (- 11 (length field)) ?\ ) | |
709 | "%v") | |
710 | :value (or (cadr (assoc field values)) "")))) | |
711 | ret)) | |
712 | (widget-insert "\n") | |
713 | ;; Deactivate editable field | |
714 | (widget-apply (cadr (nth 1 ret)) :deactivate))) | |
715 | mairix-widget-fields-list) | |
716 | ret)) | |
717 | ||
718 | (defun mairix-widget-add (name &rest args) | |
719 | "Add a widget NAME with optional ARGS." | |
720 | (push | |
721 | (list name | |
722 | (apply 'widget-create args)) | |
723 | mairix-widgets)) | |
724 | ||
725 | (defun mairix-widget-toggle-activate (widget) | |
726 | "Toggle activation status of WIDGET depending on checkbox value." | |
727 | (let ((field (widget-get widget :tag))) | |
728 | (if (widget-value widget) | |
729 | (widget-apply | |
730 | (cadr (assoc (concat "e" field) mairix-widgets)) | |
731 | :activate) | |
732 | (widget-apply | |
733 | (cadr (assoc (concat "e" field) mairix-widgets)) | |
734 | :deactivate))) | |
735 | (widget-setup)) | |
736 | ||
737 | ||
738 | ;;;; Major mode for editing/deleting/saving searches | |
739 | ||
740 | (defvar mairix-searches-mode-map nil "'mairix-searches-mode' keymap.") | |
741 | ||
742 | ;; Keymap | |
743 | (if (not mairix-searches-mode-map) | |
744 | (let ((map (make-keymap))) | |
745 | (define-key map [(return)] 'mairix-select-search) | |
746 | (define-key map [(down)] 'mairix-next-search) | |
747 | (define-key map [(up)] 'mairix-previous-search) | |
748 | (define-key map [(right)] 'mairix-next-search) | |
749 | (define-key map [(left)] 'mairix-previous-search) | |
750 | (define-key map "\C-p" 'mairix-previous-search) | |
751 | (define-key map "\C-n" 'mairix-next-search) | |
752 | (define-key map [(q)] 'mairix-select-quit) | |
753 | (define-key map [(e)] 'mairix-select-edit) | |
754 | (define-key map [(d)] 'mairix-select-delete) | |
755 | (define-key map [(s)] 'mairix-select-save) | |
756 | (setq mairix-searches-mode-map map))) | |
757 | ||
758 | (defvar mairix-searches-mode-font-lock-keywords) | |
759 | ||
760 | (defun mairix-searches-mode () | |
761 | "Major mode for editing mairix searches." | |
762 | (interactive) | |
763 | (kill-all-local-variables) | |
764 | (setq major-mode 'mairix-searches-mode) | |
765 | (setq mode-name "mairix-searches") | |
766 | (set-syntax-table text-mode-syntax-table) | |
767 | (use-local-map mairix-searches-mode-map) | |
768 | (make-local-variable 'font-lock-defaults) | |
769 | (setq mairix-searches-mode-font-lock-keywords | |
770 | (list (list "^\\([0-9]+\\)" | |
771 | '(1 font-lock-constant-face)) | |
772 | (list "^[0-9 ]+\\(Name:\\) \\(.*\\)" | |
773 | '(1 font-lock-keyword-face) '(2 font-lock-string-face)) | |
774 | (list "^[ ]+\\(Query:\\) \\(.*\\) , " | |
775 | '(1 font-lock-keyword-face) '(2 font-lock-string-face)) | |
776 | (list ", \\(Threads:\\) \\(.*\\)" | |
777 | '(1 font-lock-keyword-face) '(2 font-lock-constant-face)) | |
778 | (list "^\\([A-Z].*\\)$" | |
779 | '(1 font-lock-comment-face)) | |
780 | (list "^[ ]+\\(Folder:\\) \\(.*\\)" | |
781 | '(1 font-lock-keyword-face) '(2 font-lock-string-face)))) | |
782 | (setq font-lock-defaults '(mairix-searches-mode-font-lock-keywords))) | |
783 | ||
784 | (defun mairix-build-search-list () | |
785 | "Display saved searches in current buffer." | |
786 | (insert "These are your current saved mairix searches.\n\ | |
787 | You may use the following keys in this buffer: \n\ | |
788 | Return: execute search, e: edit, d: delete, s: save, q: quit\n\ | |
789 | Use cursor keys or C-n,C-p to select next/previous search.\n\n") | |
790 | (let ((num 0) | |
791 | (beg (point)) | |
792 | current) | |
793 | (while (< num (length mairix-saved-searches)) | |
794 | (setq current (nth num mairix-saved-searches)) | |
795 | (setq num (1+ num)) | |
796 | (mairix-insert-search-line num current) | |
797 | (insert "\n")) | |
798 | (goto-char beg))) | |
799 | ||
800 | (defun mairix-insert-search-line (number field) | |
801 | "Insert new mairix query with NUMBER and values FIELD in buffer." | |
802 | (insert | |
803 | (format "%d Name: %s\n Query: %s , Threads: %s\n Folder: %s\n" | |
804 | number | |
805 | (car field) | |
806 | (nth 1 field) | |
807 | (if (nth 3 field) | |
808 | "Yes" | |
809 | "No") | |
810 | (if (nth 2 field) | |
811 | (nth 2 field) | |
812 | "Default")))) | |
813 | ||
814 | (defun mairix-select-search () | |
815 | "Call mairix with currently selected search." | |
816 | (interactive) | |
817 | (beginning-of-line) | |
818 | (if (not (looking-at "[0-9]+ Name")) | |
819 | (progn | |
820 | (ding) | |
821 | (message "Put cursor on a line with a search name first")) | |
822 | (progn | |
823 | (let* ((query (nth | |
824 | (1- (read (current-buffer))) | |
825 | mairix-saved-searches)) | |
826 | (folder (nth 2 query))) | |
827 | (when (not folder) | |
828 | (setq folder mairix-search-file)) | |
829 | (mairix-call-mairix | |
830 | (split-string (nth 1 query)) | |
831 | folder | |
832 | (car (last query))) | |
833 | (mairix-select-quit) | |
834 | (mairix-show-folder folder))))) | |
835 | ||
836 | (defun mairix-next-search () | |
837 | "Jump to next search." | |
838 | (interactive) | |
839 | (if (search-forward-regexp "^[0-9]+" | |
840 | (point-max) | |
841 | t | |
842 | 2) | |
843 | (beginning-of-line) | |
844 | (ding))) | |
845 | ||
846 | (defun mairix-previous-search () | |
847 | "Jump to previous search." | |
848 | (interactive) | |
849 | (if (search-backward-regexp "^[0-9]+" | |
850 | (point-min) | |
851 | t) | |
852 | (beginning-of-line) | |
853 | (ding))) | |
854 | ||
855 | (defun mairix-select-quit () | |
856 | "Quit mairix search mode." | |
857 | (interactive) | |
858 | (when mairix-searches-changed | |
859 | (mairix-select-save)) | |
860 | (kill-buffer nil)) | |
861 | ||
862 | (defun mairix-select-save () | |
863 | "Save current mairix searches." | |
864 | (interactive) | |
865 | (when (y-or-n-p "Save mairix searches permanently in your .emacs? ") | |
866 | (customize-save-variable 'mairix-saved-searches mairix-saved-searches))) | |
867 | ||
868 | (defun mairix-select-edit () | |
869 | "Edit currently selected mairix search." | |
870 | (interactive) | |
871 | (beginning-of-line) | |
872 | (if (not (looking-at "[0-9]+ Name")) | |
873 | (error "Put cursor on a line with a search name first") | |
874 | (progn | |
875 | (let* ((number (1- (read (current-buffer)))) | |
876 | (query (nth number mairix-saved-searches)) | |
877 | (folder (nth 2 query)) | |
878 | newname newquery newfolder threads) | |
879 | (backward-char) | |
880 | (setq newname (read-string "Name of the search: " (car query))) | |
881 | (when (assoc newname (remq (nth number mairix-saved-searches) | |
882 | mairix-saved-searches)) | |
883 | (error "This name does already exist")) | |
884 | (setq newquery (read-string "Query: " (nth 1 query))) | |
885 | (setq threads (y-or-n-p "Include whole threads? ")) | |
886 | (setq newfolder | |
887 | (read-string "Mail folder (use empty string for default): " | |
888 | folder)) | |
889 | (when (zerop (length newfolder)) | |
890 | (setq newfolder nil)) | |
891 | ;; set new values | |
892 | (setcar (nth number mairix-saved-searches) newname) | |
893 | (setcdr (nth number mairix-saved-searches) | |
894 | (list newquery newfolder threads)) | |
895 | (setq mairix-searches-changed t) | |
896 | (let ((beg (point))) | |
897 | (forward-line 3) | |
898 | (end-of-line) | |
899 | (delete-region beg (point)) | |
900 | (mairix-insert-search-line (1+ number) | |
901 | (nth number mairix-saved-searches)) | |
902 | (goto-char beg)))))) | |
903 | ||
904 | (defun mairix-select-delete () | |
905 | "Delete currently selected mairix search." | |
906 | (interactive) | |
907 | (if (not (looking-at "[0-9]+ Name")) | |
908 | (error "Put cursor on a line with a search name first") | |
909 | (progn | |
910 | (let* ((number (1- (read (current-buffer)))) | |
911 | (query (nth number mairix-saved-searches)) | |
912 | beg) | |
913 | (backward-char) | |
914 | (when (y-or-n-p (format "Delete search %s ? " (car query))) | |
915 | (setq mairix-saved-searches | |
916 | (delq query mairix-saved-searches)) | |
917 | (setq mairix-searches-changed t) | |
918 | (setq beg (point)) | |
919 | (forward-line 4) | |
920 | (beginning-of-line) | |
921 | (delete-region beg (point)) | |
922 | (while (search-forward-regexp "^[0-9]+" | |
923 | (point-max) | |
924 | t | |
925 | 1) | |
926 | (replace-match (number-to-string | |
927 | (setq number (1+ number))))))) | |
928 | (beginning-of-line)))) | |
929 | ||
930 | (defun mairix-widget-get-values () | |
931 | "Create values for editable fields from current article." | |
932 | (let ((get-mail-header | |
933 | (cadr (assq mairix-mail-program mairix-get-mail-header-functions)))) | |
934 | (if get-mail-header | |
935 | (save-excursion | |
936 | (save-restriction | |
937 | (mapcar | |
938 | (function | |
939 | (lambda (field) | |
940 | (list (car (cddr field)) | |
941 | (if (car field) | |
942 | (mairix-replace-illegal-chars | |
943 | (funcall get-mail-header (car field))) | |
944 | nil)))) | |
945 | mairix-widget-fields-list))) | |
946 | (error "No function for obtaining mail header specified")))) | |
947 | ||
948 | ||
949 | (provide 'mairix) | |
950 | ||
951 | ;;; mairix.el ends here | |
952 | ||
f1902fc0 | 953 | ;; arch-tag: 787ab678-fcd5-4c50-9295-01c2ee5124a6 |