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