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