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