Mercurial > emacs
annotate lisp/gnus/nnmairix.el @ 95613:7e79847f2451
*** empty log message ***
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Sat, 07 Jun 2008 02:34:01 +0000 |
parents | 15ffd5c2dc17 |
children | 14c8c38285b0 |
rev | line source |
---|---|
92255 | 1 ;;; nnmairix.el --- Mairix back end for Gnus, the Emacs newsreader |
2 | |
3 ;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: David Engster <dengste@eml.cc> | |
6 ;; Keywords: mail searching | |
7 ;; Version: 0.5 | |
8 | |
92257 | 9 ;; This file is part of GNU Emacs. |
10 | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
92359
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
92255 | 12 ;; it under the terms of the GNU General Public License as published by |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
92359
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
92359
diff
changeset
|
14 ;; (at your option) any later version. |
92255 | 15 |
92257 | 16 ;; GNU Emacs is distributed in the hope that it will be useful, |
92255 | 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
92359
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
92255 | 23 |
24 ;;; Commentary: | |
25 | |
26 ;; THIS IS BETA SOFTWARE! This back end should not mess up or | |
27 ;; even delete your mails, but having a backup is always a good idea. | |
28 | |
29 ;; This is a back end for using the mairix search engine with | |
30 ;; Gnus. Mairix is a tool for searching words in locally stored | |
31 ;; mail. Mairix is very fast which allows using it efficiently for | |
32 ;; "smart folders", e.g. folders which are associated with search | |
33 ;; queries. Of course, you can also use this back end just for | |
34 ;; calling mairix with some search query. | |
35 ;; | |
36 ;; Mairix is written by Richard Curnow. More information can be found at | |
37 ;; http://www.rpcurnow.force9.co.uk/mairix/ | |
38 ;; | |
39 ;; For details about setting up mairix&Gnus&nnmairix.el, look at the | |
40 ;; emacswiki: | |
41 ;; | |
42 ;; http://www.emacswiki.org/cgi-bin/wiki/GnusMairix | |
43 ;; | |
44 ;; The newest version of nnmairix.el can be found at | |
92257 | 45 ;; |
92255 | 46 ;; http://www.emacswiki.org/cgi-bin/emacs/nnmairix.el |
47 | |
48 ;; For impatient people, here's the setup in a nutshell: | |
49 ;; | |
50 ;; This back end requires an installed mairix binary which is | |
51 ;; configured to index your mail folder. You don't have to specify a | |
52 ;; search folder (but it does no harm, either). Visit the man page of | |
53 ;; mairix and mairixrc for details. | |
54 ;; | |
55 ;; Put nnmairix.el into your search path and "(require 'nnmarix)" into | |
56 ;; your .gnus. Then call nnmairix-create-default-group (or 'G b | |
57 ;; c'). This function will ask for all necessary information to create | |
58 ;; a mairix server in Gnus with the default search folder. This | |
59 ;; default search folder will be used for all temporary searches: call | |
60 ;; nnmairix-search ('G b s') and enter a mairix query (like | |
61 ;; f:test@example.com). To create a mairix group for one specific | |
62 ;; search query, use 'G b g'. See the emacswiki or the source for more | |
63 ;; information. | |
64 | |
65 ;; Commentary on the code: nnmairix sits between Gnus and the "real" | |
66 ;; back end which handles the mail (currently nnml, nnimap and | |
67 ;; nnmaildir were tested). I know this is all a bit hacky, but so far | |
68 ;; it works for me. This is the first back end I've written for Gnus, | |
69 ;; so I'd appreciate any comments, suggestions, bug reports (and, of | |
70 ;; course, patches) for improving nnmairix. | |
71 | |
72 ;; nnmairix does not use an active file, since I wanted to contain the | |
73 ;; back end "inside Gnus" as much as possible without the need of an | |
74 ;; external file. It stores the query/folder information in the group | |
75 ;; parameters instead. This also implies that once you kill a mairix | |
76 ;; group, it's gone for good. I don't think that this is really | |
77 ;; problematic, since I don't see the need in unsubscribing and | |
78 ;; re-subscribing search groups | |
79 | |
80 ;; Every mairix server is "responsible" for one mairix installation, | |
81 ;; i.e. you can have several mairix servers for different mairix | |
82 ;; configurations. Not that I think anyone will actually do this, but | |
83 ;; I thought it would be a "nice to have feature"... | |
84 | |
85 ;; KNOWN BUGS: | |
86 ;; * When using Maildir: path and filename of a mail can change due to | |
87 ;; reading/replying/etc. This can lead to dangling symlinks in | |
88 ;; nnmairix groups and it depends on the back end how well it deals | |
89 ;; with that (some IMAP servers out there may not be amused). Update the | |
90 ;; database ('G b u') and the group to fix it. | |
91 ;; * Mairix does only support us-ascii characters. | |
92 | |
93 ;; TODO/MISSING FEATURES: | |
94 ;; * Possibility to propagate flags like seen, replied, ticked | |
95 ;; to original message | |
96 ;; * Support of more back ends (nnmh, nnfolder, nnmbox...)? | |
97 ;; * Maybe use an active file instead of group parameters? | |
98 ;; * Use "-a" when updating groups which are not newly created | |
92257 | 99 |
92255 | 100 ;;; Changelog: |
101 ;; | |
102 ;; 02/06/2008 - version 0.5 | |
92257 | 103 ;; |
92255 | 104 ;; * New function: nnmairix-goto-original-article. Uses the |
105 ;; registry or the mail file path for determining original group. | |
92257 | 106 ;; |
92255 | 107 ;; * Deal with empty Xref header |
108 ;; | |
109 ;; * Changed summary mode keybindings since the old ones were | |
110 ;; already taken | |
111 ;; | |
112 ;; (Thanks to Tassilo Horn and Ted Zlatanov for their help) | |
113 ;; | |
114 ;; 01/07/2008 - version 0.4 | |
115 ;; | |
116 ;; * New/fixed doc strings and code cleanup. | |
117 ;; | |
118 ;; 18/11/2007 - version 0.3 | |
119 ;; | |
120 ;; * Fixed bugs when dealing with nnml and native servers | |
92257 | 121 ;; |
92255 | 122 ;; * Make variables customizable |
123 ;; | |
124 ;; 10/10/2007 - version 0.2 | |
125 ;; | |
126 ;; * Use nnml-directory/directory server variables for nnml and | |
127 ;; nnmaildir backends as path for search folders. This way it | |
128 ;; becomes independent of 'base' setting in .mairixirc (but not for | |
129 ;; nnimap). | |
130 ;; | |
131 ;; * As a result: Changed nnmairix-backend-to-server so that user | |
132 ;; is asked when more than one nnmairix server exists and we do not | |
133 ;; know which one is responsible for current backend. | |
134 ;; | |
135 ;; * Rename files when using nnml backends so that there are no | |
136 ;; holes in article numbers. This should fix all problems regarding | |
137 ;; wrong article counts with nnml. | |
138 ;; | |
139 ;; * More commands for creating queries (using widgets or the | |
140 ;; minibuffer). | |
141 ;; | |
142 ;; * Fixed bug in nnmairix-create-search-group-from-message | |
143 ;; | |
144 ;; * Changed copyright to FSF | |
145 ;; | |
146 ;; (Thanks to Georg C. F. Greve and Bastien for suggestions and | |
147 ;; ideas!) | |
148 ;; | |
149 ;; 10/03/2007 - version 0.1 - first release | |
150 | |
151 | |
152 ;;; Code: | |
153 | |
154 (require 'nnoo) | |
155 (require 'gnus-group) | |
156 (require 'gnus-sum) | |
157 (require 'message) | |
158 (require 'nnml) | |
159 (require 'widget) | |
160 | |
161 (nnoo-declare nnmairix) | |
162 | |
163 ;;; === Keymaps | |
164 | |
95451 | 165 (eval-when-compile |
166 (when (featurep 'xemacs) | |
167 ;; The `kbd' macro requires that the `read-kbd-macro' macro is available. | |
168 (require 'edmacro))) | |
169 | |
92255 | 170 ;; Group mode |
171 (defun nnmairix-group-mode-hook () | |
172 "Nnmairix group mode keymap." | |
173 (define-key gnus-group-mode-map | |
174 (kbd "G b") (make-sparse-keymap)) | |
175 (define-key gnus-group-mode-map | |
176 (kbd "G b g") 'nnmairix-create-search-group) | |
177 (define-key gnus-group-mode-map | |
178 (kbd "G b c") 'nnmairix-create-server-and-default-group) | |
179 (define-key gnus-group-mode-map | |
180 (kbd "G b q") 'nnmairix-group-change-query-this-group) | |
181 (define-key gnus-group-mode-map | |
182 (kbd "G b t") 'nnmairix-group-toggle-threads-this-group) | |
183 (define-key gnus-group-mode-map | |
184 (kbd "G b u") 'nnmairix-update-database) | |
185 (define-key gnus-group-mode-map | |
186 (kbd "G b s") 'nnmairix-search) | |
187 (define-key gnus-group-mode-map | |
188 (kbd "G b i") 'nnmairix-search-interactive) | |
189 (define-key gnus-group-mode-map | |
190 (kbd "G b m") 'nnmairix-widget-search)) | |
191 | |
192 ;; Summary mode | |
193 (defun nnmairix-summary-mode-hook () | |
194 "Nnmairix summary mode keymap." | |
195 (define-key gnus-summary-mode-map | |
196 (kbd "$ t") 'nnmairix-search-thread-this-article) | |
197 (define-key gnus-summary-mode-map | |
198 (kbd "$ f") 'nnmairix-search-from-this-article) | |
199 (define-key gnus-summary-mode-map | |
200 (kbd "$ m") 'nnmairix-widget-search-from-this-article) | |
201 (define-key gnus-summary-mode-map | |
202 (kbd "$ g") 'nnmairix-create-search-group-from-message) | |
203 (define-key gnus-summary-mode-map | |
204 (kbd "$ o") 'nnmairix-goto-original-article)) | |
205 | |
206 (add-hook 'gnus-group-mode-hook 'nnmairix-group-mode-hook) | |
207 (add-hook 'gnus-summary-mode-hook 'nnmairix-summary-mode-hook) | |
208 | |
209 | |
210 ;; Customizable stuff | |
211 | |
212 (defgroup nnmairix nil | |
213 "Backend for the Mairix mail search engine." | |
214 :group 'gnus) | |
215 | |
216 (defcustom nnmairix-group-prefix "zz_mairix" | |
217 "Prefix for mairix search groups on back end server. | |
218 nnmairix will create these groups automatically on the back end | |
219 server for each nnmairix search group. The name on the back end | |
220 server will be this prefix plus a random number. You can delete | |
221 unused nnmairix groups on the back end using | |
222 `nnmairix-purge-old-groups'." | |
92257 | 223 :version "23.1" |
92255 | 224 :type 'string |
225 :group 'nnmairix) | |
226 | |
227 (defcustom nnmairix-mairix-output-buffer "*mairix output*" | |
228 "Buffer used for mairix output." | |
92257 | 229 :version "23.1" |
92255 | 230 :type 'string |
231 :group 'nnmairix) | |
232 | |
233 (defcustom nnmairix-customize-query-buffer "*mairix query*" | |
234 "Name of the buffer for customizing Mairix queries." | |
92257 | 235 :version "23.1" |
92255 | 236 :type 'string |
237 :group 'nnmairix) | |
238 | |
239 (defcustom nnmairix-mairix-update-options '("-F" "-Q") | |
240 "Options when calling mairix for updating the database. | |
241 The default is '-F' and '-Q' for making updates faster. You | |
242 should call mairix without these options from time to | |
243 time (e.g. via cron job)." | |
92257 | 244 :version "23.1" |
92255 | 245 :type '(repeat string) |
246 :group 'nnmairix) | |
247 | |
248 (defcustom nnmairix-mairix-synchronous-update nil | |
249 "Set this to t if you want Emacs to wait for mairix updating the database." | |
92257 | 250 :version "23.1" |
92255 | 251 :type 'boolean |
252 :group 'nnmairix) | |
253 | |
254 (defcustom nnmairix-rename-files-for-nnml t | |
255 "Rename nnml mail files so that they are consecutively numbered. | |
256 When using nnml as backend, mairix might produce holes in the | |
257 article numbers which will produce wrong article counts by | |
258 Gnus. This option controls whether nnmairix should rename the | |
259 files consecutively." | |
92257 | 260 :version "23.1" |
92255 | 261 :type 'boolean |
262 :group 'nnmairix) | |
263 | |
264 (defcustom nnmairix-widget-fields-list | |
265 '(("from" "f" "From") ("to" "t" "To") ("cc" "c" "Cc") | |
266 ("subject" "s" "Subject") ("to" "tc" "To or Cc") | |
267 ("from" "a" "Address") (nil "b" "Body") (nil "n" "Attachment") | |
268 ("Message-ID" "m" "Message ID") (nil "s" "Size") (nil "d" "Date")) | |
269 "Fields that should be editable during interactive query customization. | |
270 | |
271 Header, corresponding mairix command and description for editable | |
272 fields in interactive query customization. The header specifies | |
273 which header contents should be inserted into the editable field | |
274 when creating a Mairix query based on the current message (can be | |
275 nil for disabling this)." | |
92257 | 276 :version "23.1" |
92255 | 277 :type '(repeat (list |
278 (choice :tag "Field" | |
279 (const :tag "none" nil) | |
280 (const :tag "From" "from") | |
281 (const :tag "To" "to") | |
282 (const :tag "Cc" "cc") | |
283 (const :tag "Subject" "subject") | |
284 (const :tag "Message ID" "Message-ID")) | |
285 (string :tag "Command") | |
286 (string :tag "Description"))) | |
287 :group 'nnmairix) | |
288 | |
289 (defcustom nnmairix-widget-select-window-function | |
290 (lambda () (select-window (get-largest-window))) | |
291 "Function for selecting the window for customizing the mairix query. | |
292 The default chooses the largest window in the current frame." | |
92257 | 293 :version "23.1" |
92255 | 294 :type 'function |
295 :group 'nnmairix) | |
296 | |
297 ;; ==== Other variables | |
298 | |
299 (defvar nnmairix-widget-other | |
300 '(threads flags) | |
301 "Other editable mairix commands when using customization widgets. | |
302 Currently there are 'threads and 'flags.") | |
303 | |
304 (defvar nnmairix-interactive-query-parameters | |
305 '((?f "from" "f" "From") (?t "to" "t" "To") (?c "to" "tc" "To or Cc") | |
306 (?a "from" "a" "Address") (?s "subject" "s" "Subject") (?b nil "b" "Body") | |
307 (?d nil "d" "Date") (?n nil "n" "Attachment")) | |
308 "Things that should be editable during interactive query generation. | |
309 Every list element consists of the following entries: Keystroke, | |
310 message field (if any), mairix command and description.") | |
311 | |
312 (defvar nnmairix-delete-and-create-on-change '(nnimap nnmaildir nnml) | |
313 "Controls on which backends groups should be deleted and re-created. | |
314 This variable is a list of back ends where the search group should | |
315 be completely deleted and re-created when the query or thread | |
316 parameter changes. I know this is rather \"brute force\" and maybe | |
317 even dangerous (you have backups, right?), but it should be used at | |
318 least for nnimap since some IMAP servers are really not amused when | |
319 mailbox content changes behind their back. It usually also corrects | |
320 the problem of \"holes\" in the article numbers which often lead to a | |
321 wrong count of total articles shown by Gnus.") | |
322 | |
323 ;;; === Server variables | |
324 | |
325 (defvoo nnmairix-backend nil | |
326 "Backend where mairix stores its searches.") | |
327 | |
328 (defvoo nnmairix-backend-server nil | |
329 "Name of the server where mairix stores its searches.") | |
330 | |
331 (defvoo nnmairix-mairix-command "mairix" | |
332 "Command to call mairix for this nnmairix server.") | |
333 | |
334 (defvoo nnmairix-hidden-folders nil | |
335 "Set this to t if the back end server uses hidden directories for | |
336 its maildir mail folders (e.g. the Dovecot IMAP server or mutt).") | |
337 | |
338 (defvoo nnmairix-default-group nil | |
339 "Default search group. This is the group which is used for all | |
340 temporary searches, e.g. nnmairix-search.") | |
341 | |
342 ;;; === Internal variables | |
343 | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
344 (defconst nnmairix-group-regexp |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
345 (format "%s-\\(.*\\)-[0-9]+" nnmairix-group-prefix) |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
346 "Regexp for mairix groups on back end.") |
92255 | 347 |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
348 (defconst nnmairix-valid-backends '(nnimap nnml nnmaildir) |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
349 "Backends supported by nnmairix. |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
350 Other backends might or might not work.") |
92255 | 351 |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
352 (defvar nnmairix-last-server nil |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
353 "Last chosen server.") |
92255 | 354 |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
355 (defvar nnmairix-current-server nil |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
356 "Current server.") |
92255 | 357 |
358 ;;; === Gnus backend functions | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
359 |
92255 | 360 (nnoo-define-basics nnmairix) |
361 | |
362 (gnus-declare-backend "nnmairix" 'mail 'address) | |
363 | |
364 (deffoo nnmairix-open-server (server &optional definitions) | |
365 ;; just set server variables | |
366 (setq nnmairix-current-server server) | |
367 (nnoo-change-server 'nnmairix server definitions)) | |
368 | |
369 (deffoo nnmairix-request-group (group &optional server fast) | |
370 ;; Call mairix and request group on back end server | |
371 (when server (nnmairix-open-server server)) | |
372 (let* ((qualgroup (if server | |
373 (gnus-group-prefixed-name group (list 'nnmairix server)) | |
374 group)) | |
375 (query (gnus-group-get-parameter qualgroup 'query t)) | |
376 (folder (gnus-group-get-parameter qualgroup 'folder)) | |
377 (threads (gnus-group-get-parameter qualgroup 'threads)) | |
378 (backendmethod (gnus-server-to-method | |
379 (format "%s:%s" (symbol-name nnmairix-backend) | |
380 nnmairix-backend-server))) | |
381 rval mfolder folderpath) | |
382 (cond | |
383 ((not folder) | |
384 ;; No folder parameter -> error | |
385 (nnheader-report 'nnmairix "Check folder parameter for group %s" group) | |
386 nil) | |
387 ((not query) | |
388 ;; No query -> return empty group | |
389 (save-excursion | |
390 (set-buffer nntp-server-buffer) | |
391 (erase-buffer) | |
392 (insert (concat "211 0 1 0 " group)) | |
393 t)) | |
394 (t | |
395 ;; For maildir++ folders: create a hidden directory (prepend dot) | |
396 (setq mfolder (if (and nnmairix-hidden-folders | |
397 (not (string-match "^\\." folder))) | |
398 (concat "." folder) | |
399 folder)) | |
400 ;; For nnml and nnmaildir, precede mfolder with directory where mail | |
401 ;; is actually stored so that it's independent of 'base' setting | |
402 ;; in .mairixrc. | |
403 (when (eq nnmairix-backend 'nnml) | |
404 (setq folderpath (cadr (assoc 'nnml-directory backendmethod))) | |
405 ;; if nnml-directory is not explicitly set, use global value | |
406 (when (not folderpath) | |
407 (setq folderpath nnml-directory))) | |
408 (when (eq nnmairix-backend 'nnmaildir) | |
409 (setq folderpath | |
410 (cadr (assoc 'directory backendmethod)))) | |
411 (when folderpath | |
412 (setq mfolder | |
413 (concat | |
414 (file-name-as-directory | |
415 (expand-file-name | |
416 folderpath)) | |
417 mfolder))) | |
418 ;; If (not fast), call Mairix binary | |
419 (setq rval | |
420 (if fast 0 | |
421 (nnmairix-call-mairix-binary | |
422 (split-string nnmairix-mairix-command) | |
423 mfolder query threads))) | |
424 ;; Check return value | |
425 (cond | |
426 ((zerop rval) ; call was succesful | |
427 (nnmairix-call-backend | |
428 "open-server" nnmairix-backend-server) | |
429 ;; If we're dealing with nnml, rename files | |
430 ;; consecutively and make new active file for this | |
431 ;; group | |
432 (when (eq nnmairix-backend 'nnml) | |
433 (when nnmairix-rename-files-for-nnml | |
434 (nnmairix-rename-files-consecutively mfolder)) | |
435 (nnml-generate-nov-databases-directory mfolder)) | |
436 (nnmairix-call-backend | |
437 "request-scan" folder nnmairix-backend-server) | |
438 (if fast | |
439 t | |
92359 | 440 (nnmairix-request-group-with-article-number-correction |
441 folder qualgroup))) | |
92255 | 442 ((and (= rval 1) |
443 (save-excursion (set-buffer nnmairix-mairix-output-buffer) | |
444 (goto-char (point-min)) | |
445 (looking-at "^Matched 0 messages"))) | |
446 ;; No messages found -> return empty group | |
447 (nnheader-message 5 "Mairix: No matches found.") | |
448 (set-buffer nntp-server-buffer) | |
449 (erase-buffer) | |
450 (insert (concat "211 0 1 0 " group)) | |
451 t) | |
452 ;; Everything else is an error | |
453 (t | |
454 (nnheader-report | |
455 'nnmairix "Error running marix. See buffer %s for details" | |
456 nnmairix-mairix-output-buffer) | |
457 nil)))))) | |
458 | |
459 | |
460 (deffoo nnmairix-request-create-group (group &optional server args) | |
461 (let ((qualgroup (if server (gnus-group-prefixed-name group (list 'nnmairix server)) | |
462 group)) | |
463 (exist t) | |
464 (count 0) | |
465 groupname info) | |
466 (when server (nnmairix-open-server server)) | |
467 (gnus-group-add-parameter qualgroup '(query . nil)) | |
468 (gnus-group-add-parameter qualgroup '(threads . nil)) | |
469 (while exist | |
470 (setq count (1+ count)) | |
471 (setq groupname (format "%s-%s-%s" nnmairix-group-prefix group | |
472 (number-to-string count))) | |
473 (setq exist (nnmairix-call-backend | |
474 "request-group" groupname nnmairix-backend-server))) | |
475 (nnmairix-call-backend | |
476 "request-create-group" groupname nnmairix-backend-server) | |
477 (gnus-group-add-parameter qualgroup '(folder . nil)) | |
478 (gnus-group-set-parameter qualgroup 'folder groupname)) | |
479 t) | |
480 | |
481 | |
482 (deffoo nnmairix-retrieve-headers (articles group &optional server fetch-old) | |
483 (when server (nnmairix-open-server server)) | |
484 (let* ((folder (nnmairix-get-backend-folder group server)) | |
485 (corr (nnmairix-get-numcorr group server)) | |
486 (numcorr 0) | |
487 rval) | |
488 (when (and corr | |
489 (not (zerop (cadr corr))) | |
490 (numberp (car articles))) | |
491 (setq numcorr (cadr corr)) | |
492 (setq articles | |
493 (mapcar | |
494 (lambda (arg) (- arg numcorr)) | |
495 articles))) | |
496 (setq rval (nnmairix-call-backend | |
497 "retrieve-headers" articles folder nnmairix-backend-server fetch-old)) | |
498 (when (eq rval 'nov) | |
499 (nnmairix-replace-group-and-numbers articles folder group numcorr) | |
500 rval))) | |
501 | |
502 (deffoo nnmairix-request-article (article &optional group server to-buffer) | |
503 (when server (nnmairix-open-server server)) | |
504 (let ((folder (nnmairix-get-backend-folder group server)) | |
505 (corr (nnmairix-get-numcorr group server))) | |
506 (when (and | |
507 (numberp article) | |
508 corr | |
509 (not (zerop (cadr corr)))) | |
510 (setq article (- article (cadr corr)))) | |
511 (nnmairix-call-backend | |
512 "request-article" article folder nnmairix-backend-server to-buffer)) | |
513 t) | |
514 | |
515 (deffoo nnmairix-close-group (group &optional server) | |
516 ;; Should we do something here? | |
517 nil) | |
518 | |
519 | |
520 (deffoo nnmairix-request-list (&optional server) | |
521 (when server (nnmairix-open-server server)) | |
522 (if (nnmairix-call-backend "request-list" nnmairix-backend-server) | |
523 (let (cpoint cur qualgroup folder) | |
524 (save-excursion | |
525 (set-buffer nntp-server-buffer) | |
526 (goto-char (point-min)) | |
527 (setq cpoint (point)) | |
528 (while (re-search-forward nnmairix-group-regexp (point-max) t) | |
529 (setq cur (match-string 1) | |
530 qualgroup (gnus-group-prefixed-name cur | |
531 (list 'nnmairix server))) | |
532 (if (and (gnus-group-entry qualgroup) | |
533 (string= (match-string 0) | |
534 (gnus-group-get-parameter qualgroup 'folder))) | |
535 (progn | |
536 (replace-match cur) | |
537 (delete-region cpoint (point-at-bol)) | |
538 (forward-line) | |
539 (setq cpoint (point))) | |
540 (forward-line))) | |
541 (delete-region cpoint (point-max))) | |
542 t) | |
543 nil)) | |
544 | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
545 |
92255 | 546 (nnoo-define-skeleton nnmairix) |
547 | |
548 | |
549 ;;; === Interactive functions | |
550 | |
551 (defun nnmairix-create-search-group (server group query threads) | |
552 "Create on SERVER nnmairix search group GROUP with QUERY. | |
553 If THREADS is t, include whole threads from found messages. If | |
554 called interactively, user will be asked for parameters." | |
555 (interactive | |
556 (list | |
557 (gnus-server-to-method (car (nnmairix-get-server))) | |
558 (read-string "Group name: ") | |
559 (read-string "Query: ") | |
560 (y-or-n-p "Include threads? "))) | |
561 (when (and (stringp query) | |
562 (string-match "\\s-" query)) | |
563 (setq query (split-string query))) | |
564 (when (not (listp query)) | |
565 (setq query (list query))) | |
566 (when (and server group query) | |
567 (save-excursion | |
568 (let ((groupname (gnus-group-prefixed-name group server)) | |
569 info) | |
570 (set-buffer gnus-group-buffer) | |
571 (gnus-group-make-group group server) | |
572 (gnus-group-set-parameter groupname 'query query) | |
573 (gnus-group-set-parameter groupname 'threads threads) | |
574 (nnmairix-update-and-clear-marks groupname))))) | |
575 | |
576 (defun nnmairix-search-interactive () | |
577 "Create mairix search interactively with the minibuffer." | |
578 (interactive) | |
579 (let ((char-header nnmairix-interactive-query-parameters) | |
580 header finished query achar) | |
581 (while (not finished) | |
582 (while (not achar) | |
583 (message "Query (%s): " (nnmairix-create-message-line-for-search)) | |
584 (setq achar (read-char)) | |
585 (when (not (assoc achar char-header)) | |
586 (setq achar nil))) | |
587 (setq header (read-string | |
588 (concat "Match " (nth 3 (assoc achar char-header)) " on: "))) | |
589 (push (concat (nth 2 (assoc achar char-header)) ":" header) query) | |
590 (setq finished (not (y-or-n-p "Add another search query? ")) | |
591 achar nil)) | |
592 (nnmairix-search | |
593 (mapconcat 'identity query " ") | |
594 (car (nnmairix-get-server)) | |
595 (y-or-n-p "Include whole threads? ")))) | |
596 | |
597 (defun nnmairix-create-search-group-from-message () | |
598 "Interactively create search group with query based on current message." | |
599 (interactive) | |
600 (let ((char-header nnmairix-interactive-query-parameters) | |
601 (server (nnmairix-backend-to-server gnus-current-select-method)) | |
602 query achar header finished group threads cq) | |
603 (when (or (not (gnus-buffer-live-p gnus-article-buffer)) | |
604 (not (gnus-buffer-live-p gnus-summary-buffer))) | |
605 (error "No article or summary buffer")) | |
606 (when (not server) | |
607 (error "No nnmairix server found for back end %s:%s" | |
608 (symbol-name (car gnus-current-select-method)) | |
609 (nth 1 gnus-current-select-method))) | |
610 (while (not finished) | |
611 (save-excursion | |
612 (gnus-summary-toggle-header 1) | |
613 (while (not achar) | |
614 (message "Query (%s): " (nnmairix-create-message-line-for-search)) | |
615 (setq achar (read-char)) | |
616 (when (not (assoc achar char-header)) | |
617 (setq achar nil))) | |
618 (set-buffer gnus-article-buffer) | |
619 (setq header nil) | |
620 (when (setq cq (nth 1 (assoc achar char-header))) | |
621 (setq header | |
622 (nnmairix-replace-illegal-chars | |
623 (gnus-fetch-field (nth 1 (assoc achar char-header)))))) | |
624 (setq header (read-string | |
625 (concat "Match " (nth 3 (assoc achar char-header)) " on: ") | |
626 header)) | |
627 (push (concat (nth 2 (assoc achar char-header)) ":" header) query) | |
628 (setq finished (not (y-or-n-p "Add another search query? ")) | |
629 achar nil))) | |
630 (setq threads (y-or-n-p "Include whole threads? ")) | |
631 (setq group (read-string "Group name: ")) | |
632 (set-buffer gnus-summary-buffer) | |
633 (message "Creating group %s on server %s with query %s." group | |
634 (gnus-method-to-server server) (mapconcat 'identity query " ")) | |
635 (nnmairix-create-search-group server group query threads))) | |
636 | |
637 (defun nnmairix-create-server-and-default-group () | |
638 "Interactively create new nnmairix server with default search group. | |
639 All necessary information will be queried from the user." | |
640 (interactive) | |
641 (let* ((name (read-string "Name of the mairix server: ")) | |
642 (server (completing-read "Back end server (TAB for completion): " | |
643 (nnmairix-get-valid-servers))) | |
644 (mairix (read-string "Command to call mairix: " "mairix")) | |
645 (defaultgroup (read-string "Default search group: ")) | |
646 (backend (symbol-name (car (gnus-server-to-method server)))) | |
647 (servername (nth 1 (gnus-server-to-method server))) | |
648 (hidden (and (string-match "^nn\\(imap\\|maildir\\)$" backend) | |
649 (y-or-n-p | |
650 "Does the back end server work with maildir++ (i.e. hidden directories)? "))) | |
651 create) | |
652 | |
653 (apply (intern (format "%s-%s" backend "open-server")) | |
654 (list servername)) | |
655 | |
656 (when (and hidden | |
657 (string-match "^\\." defaultgroup)) | |
658 (setq defaultgroup (substring defaultgroup 1))) | |
659 ;; Create default search group | |
660 (gnus-group-make-group | |
661 defaultgroup (list 'nnmairix name (list 'nnmairix-backend (intern backend)) | |
662 (list 'nnmairix-backend-server servername) | |
663 (list 'nnmairix-mairix-command mairix) | |
664 (list 'nnmairix-hidden-folders hidden) | |
665 (list 'nnmairix-default-group defaultgroup))))) | |
666 | |
667 | |
668 (defun nnmairix-group-change-query-this-group (&optional query) | |
669 "Set QUERY for group under cursor." | |
670 (interactive) | |
671 (let* ((group (gnus-group-group-name)) | |
672 (method (gnus-find-method-for-group group)) | |
673 (oldquery (gnus-group-get-parameter group 'query t))) | |
674 (if (eq (car method) 'nnmairix) | |
675 (progn | |
676 (when (listp oldquery) | |
677 (setq oldquery (mapconcat 'identity oldquery " "))) | |
678 (setq query (or query | |
679 (read-string "New query: " oldquery))) | |
680 (when (stringp query) | |
681 (setq query (split-string query))) | |
682 (when query | |
683 (gnus-group-set-parameter group 'query query) | |
684 (nnmairix-update-and-clear-marks group))) | |
685 (error "This is no nnmairix group")))) | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
686 |
92255 | 687 |
688 (defun nnmairix-group-toggle-threads-this-group (&optional threads) | |
689 "Toggle threads parameter for this group. | |
690 If THREADS is a positive number, set threads parameter to t. | |
691 If THREADS is a negative number, set it to nil." | |
692 (interactive) | |
693 (let* ((group (gnus-group-group-name)) | |
694 (method (gnus-find-method-for-group group)) | |
695 (getthreads (or threads | |
696 (not (gnus-group-get-parameter group 'threads))))) | |
697 (if (eq (car method) 'nnmairix) | |
698 (progn | |
699 (when (numberp getthreads) | |
700 (setq getthreads (> getthreads 0))) | |
701 (gnus-group-set-parameter group 'threads getthreads) | |
702 (if getthreads | |
703 (message "Threads activated for group %s" group) | |
704 (message "Threads deacitavted for group %s" group)) | |
705 (nnmairix-update-and-clear-marks group)) | |
706 (error "This is no nnmairix group")))) | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
707 |
92255 | 708 |
709 (defun nnmairix-search (query &optional server threads) | |
710 "Sends QUERY to nnmairix backend SERVER, using default its search group. | |
711 | |
712 Default search group is automatically entered and results are shown. | |
713 If THREADS is t, enable threads. | |
714 If THREADS is a negative number, disable threads. | |
715 Otherwise, leave threads parameter as it is." | |
716 (interactive (list (read-string "Query: "))) | |
717 (when (not server) | |
718 (setq server (car (nnmairix-get-server)))) | |
719 (if (not server) | |
720 (error "No opened nnmairix server found") | |
721 (setq server (gnus-server-to-method server))) | |
722 (nnmairix-open-server (nth 1 server)) | |
723 (let* ((qualgroup (gnus-group-prefixed-name nnmairix-default-group | |
724 (list 'nnmairix (nth 1 server))))) | |
725 (set-buffer gnus-group-buffer) | |
726 (when (stringp query) | |
727 (setq query (split-string query))) | |
728 (gnus-group-set-parameter qualgroup 'query query) | |
729 (if (symbolp threads) | |
730 (when (eq threads 't) | |
731 (gnus-group-set-parameter qualgroup 'threads t)) | |
732 (when (< threads 0) | |
733 (gnus-group-set-parameter qualgroup 'threads nil))) | |
734 (nnmairix-update-and-clear-marks qualgroup) | |
735 (when (not (zerop (gnus-group-unread qualgroup))) | |
736 (gnus-group-read-group nil t qualgroup)))) | |
737 | |
738 (defun nnmairix-search-thread-this-article () | |
739 "Search thread for the current article. | |
740 This is effectively a shortcut for calling `nnmairix-search' | |
741 with m:msgid of the current article and enabled threads." | |
742 (interactive) | |
743 (let* ((server | |
744 (nnmairix-backend-to-server gnus-current-select-method)) | |
745 mid) | |
746 (if server | |
747 (if (gnus-buffer-live-p gnus-article-buffer) | |
748 (progn | |
749 (save-excursion | |
750 (set-buffer gnus-article-buffer) | |
751 (gnus-summary-toggle-header 1) | |
752 (setq mid (message-fetch-field "Message-ID"))) | |
753 (while (string-match "[<>]" mid) | |
754 (setq mid (replace-match "" t t mid))) | |
755 (nnmairix-search (concat "m:" mid) server t)) | |
756 (message "No article buffer.")) | |
757 (error "No nnmairix server found for back end %s:%s" | |
758 (symbol-name (car gnus-current-select-method)) | |
759 (nth 1 gnus-current-select-method))))) | |
760 | |
761 (defun nnmairix-search-from-this-article () | |
762 "Search messages from sender of the current article. | |
763 This is effectively a shortcut for calling `nnmairix-search' with | |
764 f:current_from." | |
765 (interactive) | |
766 (let* ((server | |
767 (nnmairix-backend-to-server gnus-current-select-method)) | |
768 from) | |
769 (if server | |
770 (if (gnus-buffer-live-p gnus-article-buffer) | |
771 (progn | |
772 (save-excursion | |
773 (set-buffer gnus-article-buffer) | |
774 (gnus-summary-toggle-header 1) | |
775 (setq from (cadr (gnus-extract-address-components | |
776 (gnus-fetch-field "From")))) | |
777 (nnmairix-search (concat "f:" from) server -1))) | |
778 (message "No article buffer.")) | |
779 (error "No nnmairix server found for back end %s:%s" | |
780 (symbol-name (car gnus-current-select-method)) | |
781 (nth 1 gnus-current-select-method))))) | |
782 | |
783 | |
784 (defun nnmairix-purge-old-groups (&optional dontask server) | |
785 "Delete mairix search groups which are no longer used. | |
786 | |
787 You may want to call this from time to time if you are creating | |
788 and deleting lots of nnmairix groups. If DONTASK is t, do not ask | |
789 before deleting a group on the back end. SERVER specifies nnmairix server." | |
790 (interactive) | |
791 (let ((server (or server | |
792 (gnus-server-to-method (car (nnmairix-get-server)))))) | |
793 (if (nnmairix-open-server (nth 1 server)) | |
794 (when (nnmairix-call-backend | |
795 "request-list" nnmairix-backend-server) | |
796 (let (cur qualgroup folder) | |
797 (save-excursion | |
798 (set-buffer nntp-server-buffer) | |
799 (goto-char (point-min)) | |
800 (while (re-search-forward nnmairix-group-regexp (point-max) t) | |
801 (setq cur (match-string 0) | |
802 qualgroup (gnus-group-prefixed-name | |
803 (match-string 1) server)) | |
804 (when (not (and (gnus-group-entry qualgroup) | |
805 (string= cur | |
806 (gnus-group-get-parameter | |
807 qualgroup 'folder)))) | |
808 (when (or dontask | |
809 (y-or-n-p | |
810 (concat "Delete group " cur | |
811 " on server " nnmairix-backend-server "? "))) | |
812 (nnmairix-call-backend | |
813 "request-delete-group" cur t nnmairix-backend-server))))))) | |
814 (message "Couldn't open server %s" (nth 1 server))))) | |
815 | |
816 | |
817 (defun nnmairix-update-database (&optional servers) | |
818 "Call mairix for updating the database for SERVERS. | |
819 | |
820 If SERVERS is nil, do update for all nnmairix servers. Mairix | |
821 will be called asynchronously unless | |
822 `nnmairix-mairix-synchronous-update' is t. Mairix will be called | |
823 with `nnmairix-mairix-update-options'." | |
824 (interactive) | |
825 (let ((servers (or servers | |
826 (nnmairix-get-nnmairix-servers))) | |
827 args cur commandsplit) | |
828 (while servers | |
829 (setq cur (car (pop servers))) | |
830 (nnmairix-open-server | |
831 (nth 1 (gnus-server-to-method cur))) | |
832 (setq commandsplit (split-string nnmairix-mairix-command)) | |
833 (nnheader-message 7 "Updating mairix database for %s..." cur) | |
834 (if nnmairix-mairix-synchronous-update | |
835 (progn | |
836 (setq args (append (list (car commandsplit) nil | |
837 (get-buffer nnmairix-mairix-output-buffer) | |
838 nil))) | |
839 (if (> (length commandsplit) 1) | |
840 (setq args (append args (cdr commandsplit) nnmairix-mairix-update-options)) | |
841 (setq args (append args nnmairix-mairix-update-options))) | |
842 (apply 'call-process args) | |
843 (nnheader-message 7 "Updating mairix database for %s... done" cur)) | |
844 (progn | |
845 (setq args (append (list cur (get-buffer nnmairix-mairix-output-buffer) | |
846 (car commandsplit)))) | |
847 (if (> (length commandsplit) 1) | |
848 (setq args (append args (cdr commandsplit) nnmairix-mairix-update-options)) | |
849 (setq args (append args nnmairix-mairix-update-options))) | |
850 (set-process-sentinel (apply 'start-process args) | |
851 'nnmairix-sentinel-mairix-update-finished)))))) | |
852 | |
92359 | 853 ;; Silence byte-compiler. |
854 (eval-when-compile | |
855 (defvar gnus-registry-install) | |
856 (autoload 'gnus-registry-fetch-group "gnus-registry")) | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
857 |
92255 | 858 (defun nnmairix-goto-original-article (&optional no-registry) |
859 "Jump to the original group and display article. | |
860 The original group of the article is first determined with the | |
861 registry (if enabled). If the registry is not enabled or did not | |
862 find the article or the prefix NO-REGISTRY is non-nil, this | |
863 function will try to determine the original group form the path | |
864 of the mail file. The path is obtained through another mairix | |
865 search in raw mode." | |
866 (interactive "P") | |
867 (when (not (eq (car gnus-current-select-method) 'nnmairix)) | |
868 (let ((method (gnus-find-method-for-group gnus-newsgroup-name))) | |
869 (if (eq (car method) 'nnmairix) | |
870 (nnmairix-open-server (nth 1 method)) | |
871 (error "Not in a nnmairix group")))) | |
872 (when (not (gnus-buffer-live-p gnus-article-buffer)) | |
873 (error "No article buffer available")) | |
874 (let ((server (nth 1 gnus-current-select-method)) | |
875 mid rval group allgroups) | |
876 ;; get message id | |
877 (save-excursion | |
878 (set-buffer gnus-article-buffer) | |
879 (gnus-summary-toggle-header 1) | |
880 (setq mid (message-fetch-field "Message-ID")) | |
881 ;; first check the registry (if available) | |
882 (when (and (boundp 'gnus-registry-install) | |
883 gnus-registry-install | |
884 (not no-registry)) | |
885 (setq group (gnus-registry-fetch-group mid))) | |
886 (while (string-match "[<>]" mid) | |
887 (setq mid (replace-match "" t t mid))) | |
888 (unless group | |
889 ;; registry was not available or did not find article | |
890 ;; so we search again with mairix in raw mode to get filename | |
891 (nnmairix-open-server server) | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
892 (setq rval |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
893 (nnmairix-call-mairix-binary-raw |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
894 (split-string nnmairix-mairix-command) |
92255 | 895 (list (concat "m:" mid)))) |
896 (if (zerop rval) | |
897 ;; determine original group(s) from filename | |
898 (save-excursion | |
899 (set-buffer nnmairix-mairix-output-buffer) | |
900 (goto-char (point-min)) | |
901 (while (looking-at "/") | |
902 (push (nnmairix-determine-original-group) | |
903 allgroups) | |
904 (forward-line 1)) | |
905 (if (> (length allgroups) 1) | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
906 (setq group |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
907 (completing-read |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
908 "Message exists in more than one group. Choose: " |
92255 | 909 allgroups nil t)) |
910 (setq group (car allgroups)))) | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
911 (error "Mairix could not find original article. See buffer %s for details" |
92255 | 912 nnmairix-mairix-output-buffer)))) |
913 (if group | |
914 ;; show article in summary buffer | |
915 (nnmairix-show-original-article group mid) | |
916 (message "Couldn't find original article")))) | |
917 | |
918 (defun nnmairix-determine-original-group () | |
919 "Try to determine to original group from the file path." | |
920 (let (path filename serverbase group maildirflag allgroups) | |
921 (re-search-forward "^\\(.*\\)/\\(.*?\\)$") | |
922 (setq path (expand-file-name (match-string 1))) | |
923 (setq filename (match-string 2)) | |
924 ;; when we deal with maildir, remove cur/new/tmp from path | |
925 (setq maildirflag (string-match ".+\\..+\\..+" filename)) | |
926 (when maildirflag | |
927 (setq path | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
928 (replace-regexp-in-string |
92255 | 929 ".*\\(/cur\\|/new\\|/tmp\\)$" "" path t t 1))) |
930 ;; we first check nnml and nnmaildir servers | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
931 (setq |
92255 | 932 group |
933 (catch 'found | |
934 (dolist (cur gnus-opened-servers) | |
935 (when (or (and (not maildirflag) | |
936 (eq (caar cur) 'nnml)) | |
937 (and maildirflag | |
938 (eq (caar cur) 'nnmaildir))) | |
939 ;; get base path from server | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
940 (if maildirflag |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
941 (setq serverbase (cadr (assoc 'directory (car cur)))) |
92255 | 942 (setq serverbase (cadr (assoc 'nnml-directory (car cur)))) |
943 (when (not serverbase) | |
944 (setq serverbase nnml-directory))) | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
945 (setq serverbase (file-name-as-directory |
92255 | 946 (expand-file-name serverbase))) |
947 (when (string-match (concat serverbase "\\(.*\\)") path) | |
948 ;; looks good - rest of the path should be the group | |
949 (setq group (match-string 1 path)) | |
950 (when (string-match "/$" group) | |
951 (setq group (replace-match "" t t group))) | |
952 (when (not maildirflag) | |
953 ;; for nnml: convert slashes to dots | |
954 (while (string-match "/" group) | |
955 (setq group (replace-match "." t t group)))) | |
956 (setq group (gnus-group-prefixed-name group (car cur))) | |
957 ;; check whether this group actually exists | |
958 (when (gnus-group-entry group) | |
959 (throw 'found group))))))) | |
960 (unless group | |
961 ;; we haven't found it yet --> look for nnimap groups | |
962 ;; assume last element of the path is the group | |
963 (string-match "^.*/\\.?\\(.*\\)$" path) | |
964 (setq group (match-string 1 path)) | |
965 ;; convert dots to slashes (nested group) | |
966 (while (string-match "\\." group) | |
967 (setq group (replace-match "/" t t group))) | |
968 (dolist (cur gnus-opened-servers) | |
969 (when (eq (caar cur) 'nnimap) | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
970 (when (gnus-group-entry |
92255 | 971 (gnus-group-prefixed-name group (car cur))) |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
972 (push |
92255 | 973 (gnus-group-prefixed-name group (car cur)) |
974 allgroups)))) | |
975 (if (> (length allgroups) 1) | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
976 (setq group (completing-read |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
977 "Group %s exists on more than one IMAP server. Choose: " |
92255 | 978 allgroups nil t)) |
979 (setq group (car allgroups)))) | |
980 group)) | |
981 | |
982 | |
983 ;;; ==== Helper functions | |
984 | |
985 (defun nnmairix-request-group-with-article-number-correction (folder qualgroup) | |
986 "Request FOLDER on backend for nnmairix QUALGROUP and article number correction." | |
987 (save-excursion | |
92359 | 988 (nnmairix-call-backend "request-group" folder nnmairix-backend-server) |
92255 | 989 (set-buffer nnmairix-mairix-output-buffer) |
990 (goto-char (point-min)) | |
991 (re-search-forward "^Matched.*messages") | |
992 (nnheader-message 7 (match-string 0)) | |
993 (set-buffer nntp-server-buffer) | |
994 (goto-char (point-min)) | |
995 (let ((status (read (current-buffer))) | |
996 (total (read (current-buffer))) | |
997 (low (read (current-buffer))) | |
998 (high (read (current-buffer))) | |
999 (corr (gnus-group-get-parameter qualgroup 'numcorr t))) | |
1000 (if (= status 211) | |
1001 (progn | |
1002 ;; Article number correction | |
1003 (if (and corr | |
1004 (> (+ (car (cddr corr)) high) 0)) | |
1005 (progn | |
1006 (when (car corr) ;Group has changed | |
1007 (setq corr | |
1008 (list nil | |
1009 (car (cddr corr)) | |
1010 (+ (car (cddr corr)) high))) | |
1011 (gnus-group-set-parameter | |
1012 qualgroup 'numcorr corr)) | |
1013 (setq low (+ low (cadr corr)) | |
1014 high (+ high (cadr corr)))) | |
1015 (when (member nnmairix-backend | |
1016 nnmairix-delete-and-create-on-change) | |
1017 (gnus-group-set-parameter | |
1018 qualgroup 'numcorr (list nil 0 high)))) | |
1019 (erase-buffer) | |
92260
261f98568bde
(nnmairix-request-group): Bind nnmairix-fast and nnmairix-group around
Glenn Morris <rgm@gnu.org>
parents:
92259
diff
changeset
|
1020 (insert (format "%d %d %d %d %s" status total low high |
92359 | 1021 (gnus-group-real-name qualgroup))) |
92255 | 1022 t) |
1023 (progn | |
1024 (nnheader-report | |
1025 'nnmairix "Error calling back end on group %s" folder) | |
1026 nil))))) | |
1027 | |
1028 (defun nnmairix-call-mairix-binary (command folder query threads) | |
1029 "Call mairix binary with COMMAND, using FOLDER and QUERY. | |
1030 If THREADS is non-nil, enable full threads." | |
1031 (let ((args (cons (car command) '(nil t nil)))) | |
1032 (save-excursion | |
1033 (set-buffer | |
1034 (get-buffer-create nnmairix-mairix-output-buffer)) | |
1035 (erase-buffer) | |
1036 (when (> (length command) 1) | |
1037 (setq args (append args (cdr command)))) | |
1038 (when threads | |
1039 (setq args (append args '("-t")))) | |
1040 (apply 'call-process | |
1041 (append args (list "-o" folder) query))))) | |
1042 | |
1043 (defun nnmairix-call-mairix-binary-raw (command query) | |
1044 "Call mairix binary with COMMAND and QUERY in raw mode." | |
1045 (let ((args (cons (car command) '(nil t nil)))) | |
1046 (save-excursion | |
1047 (set-buffer | |
1048 (get-buffer-create nnmairix-mairix-output-buffer)) | |
1049 (erase-buffer) | |
1050 (when (> (length command) 1) | |
1051 (setq args (append args (cdr command)))) | |
1052 (setq args (append args '("-r"))) | |
1053 (apply 'call-process | |
1054 (append args query))))) | |
1055 | |
1056 (defun nnmairix-get-server () | |
1057 "If there exists just one nnmairix server, return its value. | |
1058 Otherwise, ask user for server." | |
1059 (let ((openedserver (nnmairix-get-nnmairix-servers))) | |
1060 (when (not openedserver) | |
1061 (error "No opened nnmairix server found")) | |
1062 (if (> (length openedserver) 1) | |
1063 (progn | |
1064 (while | |
1065 (equal '("") | |
1066 (setq nnmairix-last-server | |
1067 (list (completing-read "Server: " openedserver nil 1 | |
1068 (or nnmairix-last-server | |
1069 "nnmairix:")))))) | |
1070 nnmairix-last-server) | |
1071 (car openedserver)))) | |
1072 | |
1073 (defun nnmairix-get-nnmairix-servers (&optional all) | |
1074 "Return available nnmairix servers. | |
1075 If ALL is t, return also the unopened/failed ones." | |
1076 (let ((alist gnus-opened-servers) | |
1077 server openedserver) | |
1078 (while alist | |
1079 (setq server (pop alist)) | |
1080 (when (and server | |
1081 (or all | |
1082 (eq (cadr server) 'ok)) | |
1083 (eq (caar server) 'nnmairix) | |
1084 (not (member (car server) gnus-ephemeral-servers))) | |
1085 (setq server | |
1086 (concat (symbol-name (caar server)) ":" (nth 1 (car server)))) | |
1087 (push (list server) openedserver))) | |
1088 openedserver)) | |
1089 | |
1090 | |
1091 (defun nnmairix-get-valid-servers () | |
1092 "Return list of valid backend servers for nnmairix groups." | |
1093 (let ((alist gnus-opened-servers) | |
1094 (mairixservers (nnmairix-get-nnmairix-servers t)) | |
1095 server mserver openedserver occ cur) | |
1096 ;; Get list of all nnmairix backends (i.e. backends which are | |
1097 ;; already occupied) | |
1098 (dolist (cur mairixservers) | |
1099 (push | |
1100 (concat | |
1101 (symbol-name | |
1102 (cadr (assoc 'nnmairix-backend | |
1103 (gnus-server-to-method (car cur))))) | |
1104 ":" | |
1105 (cadr (assoc 'nnmairix-backend-server | |
1106 (gnus-server-to-method (car cur))))) | |
1107 occ)) | |
1108 (while alist | |
1109 (setq server (pop alist)) | |
1110 (setq mserver (gnus-method-to-server (car server))) | |
1111 ;; If this is the native server, convert it to the real server | |
1112 ;; name to avoid confusion | |
1113 (when (string= mserver "native") | |
1114 (setq mserver (format "%s:%s" | |
1115 (caar server) | |
1116 (nth 1 (car server))))) | |
1117 (when (and server | |
1118 (eq (cadr server) 'ok) | |
1119 (member (caar server) nnmairix-valid-backends) | |
1120 (not (member (car server) gnus-ephemeral-servers)) | |
1121 (not (member (gnus-method-to-server (car server)) occ))) | |
1122 (push | |
1123 (list mserver) | |
1124 openedserver))) | |
1125 openedserver)) | |
1126 | |
1127 (defun nnmairix-call-backend (func &rest args) | |
1128 "Call a function FUNC on backend with ARGS." | |
1129 (apply (intern (format "%s-%s" (symbol-name nnmairix-backend) func)) args)) | |
1130 | |
1131 (defun nnmairix-get-backend-folder (group &optional server) | |
1132 "Return back end GROUP from nnmairix group on SERVER." | |
1133 (let* ((qualgroup (if server | |
1134 (gnus-group-prefixed-name group (list 'nnmairix server)) | |
1135 group)) | |
1136 (folder (gnus-group-get-parameter qualgroup 'folder))) | |
1137 folder)) | |
1138 | |
1139 (defun nnmairix-get-numcorr (group &optional server) | |
1140 "Return values for article number correction nnmairix GROUP on SERVER." | |
1141 (let* ((qualgroup (if server | |
1142 (gnus-group-prefixed-name group (list 'nnmairix server)) | |
1143 group)) | |
1144 (corr (gnus-group-get-parameter qualgroup 'numcorr t))) | |
1145 corr)) | |
1146 | |
1147 | |
1148 (defun nnmairix-rename-files-consecutively (path) | |
1149 "Rename all nnml mail files in PATH so that they have consecutive numbers. | |
1150 This should correct problems of wrong article counts when using | |
1151 nnmairix with nnml backends." | |
1152 (let* ((files | |
1153 (sort | |
1154 (mapcar 'string-to-number | |
1155 (directory-files path nil "[0-9]+" t)) | |
1156 '<)) | |
1157 (lastplusone (car files)) | |
1158 (path (file-name-as-directory path))) | |
1159 (dolist (cur files) | |
1160 (when (not (= cur lastplusone)) | |
1161 (rename-file (concat path | |
1162 (number-to-string cur)) | |
1163 (concat path | |
1164 (number-to-string lastplusone))) | |
1165 (setq cur lastplusone)) | |
1166 (setq lastplusone (1+ cur))))) | |
1167 | |
1168 (defun nnmairix-replace-group-and-numbers (articles backendgroup mairixgroup numc) | |
1169 "Replace folder names in Xref header and correct article numbers. | |
1170 Do this for all ARTICLES on BACKENDGROUP. Replace using | |
1171 MAIRIXGROUP. NUMC contains values for article number correction." | |
1172 (let ((buf (get-buffer-create " *nnmairix buffer*")) | |
1173 (corr (not (zerop numc))) | |
1174 (name (buffer-name nntp-server-buffer)) | |
1175 header cur xref) | |
1176 (save-excursion | |
1177 (set-buffer buf) | |
1178 (erase-buffer) | |
1179 (set-buffer nntp-server-buffer) | |
1180 (goto-char (point-min)) | |
1181 (nnheader-message 7 "nnmairix: Rewriting headers...") | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1182 (mapc |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1183 (lambda (article) |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1184 (when (or (looking-at (number-to-string article)) |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1185 (nnheader-find-nov-line article)) |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1186 (setq cur (nnheader-parse-nov)) |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1187 (when corr |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1188 (setq article (+ (mail-header-number cur) numc)) |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1189 (mail-header-set-number cur article)) |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1190 (setq xref (mail-header-xref cur)) |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1191 (when (and (stringp xref) |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1192 (string-match (format "[ \t]%s:[0-9]+" backendgroup) xref)) |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1193 (setq xref (replace-match (format " %s:%d" mairixgroup article) t nil xref)) |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1194 (mail-header-set-xref cur xref)) |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1195 (set-buffer buf) |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1196 (nnheader-insert-nov cur) |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1197 (set-buffer nntp-server-buffer) |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1198 (when (not (eobp)) |
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1199 (forward-line 1)))) |
92255 | 1200 articles) |
1201 (nnheader-message 7 "nnmairix: Rewriting headers... done") | |
1202 (kill-buffer nntp-server-buffer) | |
1203 (set-buffer buf) | |
1204 (rename-buffer name) | |
1205 (setq nntp-server-buffer buf)))) | |
1206 | |
1207 (defun nnmairix-backend-to-server (server) | |
1208 "Return nnmairix server most probably responsible for back end SERVER. | |
1209 User will be asked if this cannot be determined. Result is saved in | |
1210 parameter 'indexed-servers of corresponding default search | |
1211 group." | |
1212 (let ((allservers (nnmairix-get-nnmairix-servers)) | |
1213 mairixserver found defaultgroup) | |
1214 (if (> (length allservers) 1) | |
1215 (progn | |
1216 ;; If there is more than one nnmairix server, we go through them | |
1217 (while (and allservers (not found)) | |
1218 (setq mairixserver (gnus-server-to-method (car (pop allservers)))) | |
1219 ;; First we look if SERVER is the backend of current nnmairix server | |
1220 (setq found (and (eq (cadr (assoc 'nnmairix-backend mairixserver)) | |
1221 (car server)) | |
1222 (string= (cadr (assoc 'nnmairix-backend-server mairixserver)) | |
1223 (nth 1 server)))) | |
1224 ;; If that's not the case, we look at 'indexed-servers | |
1225 ;; variable in default search group | |
1226 (when (not found) | |
1227 (setq defaultgroup (cadr (assoc 'nnmairix-default-group mairixserver))) | |
1228 (setq found (member (gnus-method-to-server server) | |
1229 (gnus-group-get-parameter | |
1230 (gnus-group-prefixed-name defaultgroup | |
1231 mairixserver) | |
1232 'indexed-servers t))))) | |
1233 ;; If still not found, we ask user | |
1234 (when (not found) | |
1235 (setq mairixserver | |
1236 (gnus-server-to-method | |
1237 (completing-read | |
1238 (format "Cannot determine which nnmairix server indexes %s. Please specify: " | |
1239 (gnus-method-to-server server)) | |
1240 (nnmairix-get-nnmairix-servers) nil nil "nnmairix:"))) | |
1241 ;; Save result in parameter of default search group so that | |
1242 ;; we don't have to ask again | |
1243 (setq defaultgroup (gnus-group-prefixed-name | |
1244 (cadr (assoc 'nnmairix-default-group mairixserver)) mairixserver)) | |
1245 (gnus-group-set-parameter | |
1246 defaultgroup | |
1247 'indexed-servers | |
1248 (append (gnus-group-get-parameter defaultgroup 'indexed-servers t) | |
1249 (list (gnus-method-to-server server))))) | |
1250 mairixserver) | |
1251 ;; If there is just one (or none) nnmairix server: | |
1252 (gnus-server-to-method (caar allservers))))) | |
1253 | |
1254 (defun nnmairix-update-and-clear-marks (group &optional method) | |
1255 "Update group and clear all marks from GROUP using METHOD." | |
1256 (when method | |
1257 (setq group (gnus-group-prefixed-name group method))) | |
1258 (let ((method (or method | |
1259 (gnus-find-method-for-group group))) | |
1260 (folder (gnus-group-get-parameter group 'folder)) | |
1261 (corr (gnus-group-get-parameter group 'numcorr t)) | |
1262 info) | |
1263 (if (eq (nth 0 method) 'nnmairix) | |
1264 (save-excursion | |
1265 (nnmairix-open-server (nth 1 method)) | |
1266 (set-buffer gnus-group-buffer) | |
1267 (setq info (gnus-get-info group)) | |
1268 ;; Clear active and info | |
1269 (gnus-set-active group nil) | |
1270 (gnus-info-clear-data info) | |
1271 ;; Delete and re-create group if needed | |
1272 (when (member nnmairix-backend nnmairix-delete-and-create-on-change) | |
1273 (if (string-match nnmairix-group-regexp folder) | |
1274 (progn | |
1275 (nnmairix-call-backend "open-server" | |
1276 nnmairix-backend-server) | |
1277 (nnmairix-call-backend "request-delete-group" | |
1278 folder t nnmairix-backend-server) | |
1279 (nnmairix-call-backend "request-create-group" | |
1280 folder nnmairix-backend-server) | |
1281 ;; set flag that group has changed for article number correction | |
1282 (when corr | |
1283 (setcar corr t) | |
1284 (gnus-group-set-parameter group 'numcorr corr))) | |
1285 (error "Nnmairix-update-and-clear-marks - delete/create with\ | |
1286 non-mairix group!! - check folder parameter"))) | |
1287 (when (gnus-group-jump-to-group group) | |
1288 (gnus-group-get-new-news-this-group))) | |
1289 (error "Nnmairix-update-and-clear-marks - Called with non-nnmairix group")))) | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1290 |
92255 | 1291 |
1292 (defun nnmairix-sentinel-mairix-update-finished (proc status) | |
1293 "Sentinel for mairix update process PROC with STATUS." | |
1294 (if (equal status "finished\n") | |
1295 (nnheader-message 7 "Updating mairix database for %s... done" proc) | |
1296 (error "There was an error updating the mairix database for server %s. \ | |
1297 See %s for details" proc nnmairix-mairix-output-buffer))) | |
1298 | |
1299 (defun nnmairix-create-message-line-for-search () | |
1300 "Create message line for interactive query in minibuffer." | |
1301 (mapconcat | |
1302 (function | |
1303 (lambda (cur) | |
1304 (format "%c=%s" (car cur) (nth 3 cur)))) | |
1305 nnmairix-interactive-query-parameters ",")) | |
1306 | |
1307 (defun nnmairix-replace-illegal-chars (header) | |
1308 "Replace illegal characters in HEADER for mairix query." | |
1309 (when header | |
1310 (if (> emacs-major-version 20) | |
1311 (while (string-match "[^-.@/,& [:alnum:]]" header) | |
1312 (setq header (replace-match "" t t header))) | |
1313 (while (string-match "[[]{}:<>]" header) | |
1314 (setq header (replace-match "" t t header)))) | |
1315 (while (string-match "[-& ]" header) | |
1316 (setq header (replace-match "," t t header))) | |
1317 header)) | |
1318 | |
1319 (defun nnmairix-show-original-article (group mid) | |
1320 "Switch to GROUP and display Article with message-id MID." | |
1321 (when (string-match "Summary" (buffer-name (current-buffer))) | |
1322 (gnus-summary-exit)) | |
1323 (pop-to-buffer gnus-group-buffer) | |
1324 (gnus-group-jump-to-group group) | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1325 (gnus-summary-read-group group 1 t) |
92255 | 1326 (gnus-summary-refer-article mid) |
1327 (gnus-summary-limit-to-headers (format "message-id: <%s>" mid)) | |
1328 (gnus-summary-select-article) | |
1329 ;; Force redisplay | |
1330 (gnus-summary-show-article) | |
1331 (nnheader-message 5 "Switched to group %s." group)) | |
1332 | |
1333 | |
1334 ;; ==== Widget stuff | |
1335 | |
1336 (defvar nnmairix-widgets) | |
1337 (defvar nnmairix-widgets-values nil) | |
1338 | |
1339 (defun nnmairix-widget-search-from-this-article () | |
1340 "Create mairix query based on current article using graphical widgets." | |
1341 (interactive) | |
1342 (nnmairix-widget-search | |
1343 (nnmairix-widget-get-values))) | |
1344 | |
1345 | |
1346 (defun nnmairix-widget-get-values () | |
1347 "Create values for editable fields from current article." | |
1348 (if (not (gnus-buffer-live-p gnus-article-buffer)) | |
1349 (error "No article buffer available") | |
1350 (save-excursion | |
1351 (gnus-summary-toggle-header 1) | |
1352 (set-buffer gnus-article-buffer) | |
1353 (mapcar | |
1354 (function | |
1355 (lambda (field) | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1356 (list (car (cddr field)) |
92255 | 1357 (if (car field) |
1358 (nnmairix-replace-illegal-chars | |
1359 (gnus-fetch-field (car field))) | |
1360 nil)))) | |
1361 nnmairix-widget-fields-list)))) | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1362 |
92255 | 1363 |
1364 (defun nnmairix-widget-search (&optional mvalues) | |
1365 "Create mairix query interactively using graphical widgets. | |
1366 MVALUES may contain values from current article." | |
1367 (interactive) | |
1368 ;; Select window for mairix customization | |
1369 (funcall nnmairix-widget-select-window-function) | |
1370 ;; generate widgets | |
1371 (nnmairix-widget-create-query mvalues) | |
1372 ;; generate Buttons | |
1373 (widget-create 'push-button | |
1374 :notify | |
1375 (if mvalues | |
1376 (lambda (&rest ignore) | |
1377 (nnmairix-widget-send-query nnmairix-widgets | |
1378 t)) | |
1379 (lambda (&rest ignore) | |
1380 (nnmairix-widget-send-query nnmairix-widgets | |
1381 nil))) | |
1382 "Send Query") | |
1383 (widget-insert " ") | |
1384 (widget-create 'push-button | |
1385 :notify | |
1386 (if mvalues | |
1387 (lambda (&rest ignore) | |
1388 (nnmairix-widget-create-group nnmairix-widgets | |
1389 t)) | |
1390 (lambda (&rest ignore) | |
1391 (nnmairix-widget-create-group nnmairix-widgets | |
1392 nil))) | |
1393 "Create permanent group") | |
1394 (widget-insert " ") | |
1395 (widget-create 'push-button | |
1396 :notify (lambda (&rest ignore) | |
1397 (kill-buffer nnmairix-customize-query-buffer)) | |
1398 "Cancel") | |
1399 (use-local-map widget-keymap) | |
1400 (widget-setup) | |
1401 (goto-char (point-min))) | |
1402 | |
1403 (defun nnmairix-widget-send-query (widgets &optional withvalues) | |
1404 "Send query from WIDGETS to mairix binary. | |
1405 If WITHVALUES is t, query is based on current article." | |
1406 (nnmairix-search | |
1407 (nnmairix-widget-make-query-from-widgets widgets) | |
1408 (if withvalues | |
1409 (gnus-method-to-server | |
1410 (nnmairix-backend-to-server gnus-current-select-method)) | |
1411 (car (nnmairix-get-server))) | |
1412 (if (widget-value (cadr (assoc "Threads" widgets))) | |
1413 t | |
1414 -1)) | |
1415 (kill-buffer nnmairix-customize-query-buffer)) | |
1416 | |
1417 (defun nnmairix-widget-create-group (widgets &optional withvalues) | |
1418 "Create nnmairix group based on current widget values WIDGETS. | |
1419 If WITHVALUES is t, query is based on current article." | |
1420 (let ((group (read-string "Name of the group: "))) | |
1421 (when (not (zerop (length group))) | |
1422 (nnmairix-create-search-group | |
1423 (if withvalues | |
1424 (gnus-method-to-server | |
1425 (nnmairix-backend-to-server gnus-current-select-method)) | |
1426 (car (nnmairix-get-server))) | |
1427 group | |
1428 (nnmairix-widget-make-query-from-widgets widgets) | |
1429 (widget-value (cadr (assoc "Threads" widgets)))))) | |
1430 (kill-buffer nnmairix-customize-query-buffer)) | |
1431 | |
1432 | |
1433 (defun nnmairix-widget-make-query-from-widgets (widgets) | |
1434 "Create mairix query from widget values WIDGETS." | |
1435 (let (query temp flag) | |
1436 ;; first we do the editable fields | |
1437 (dolist (cur nnmairix-widget-fields-list) | |
1438 ;; See if checkbox is checked | |
1439 (when (widget-value | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1440 (cadr (assoc (concat "c" (car (cddr cur))) widgets))) |
92255 | 1441 ;; create query for the field |
1442 (push | |
1443 (concat | |
1444 (nth 1 cur) | |
1445 ":" | |
1446 (nnmairix-replace-illegal-chars | |
1447 (widget-value | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1448 (cadr (assoc (concat "e" (car (cddr cur))) widgets))))) |
92255 | 1449 query))) |
1450 ;; Flags | |
1451 (when (member 'flags nnmairix-widget-other) | |
1452 (setq flag | |
1453 (mapconcat | |
1454 (function | |
1455 (lambda (flag) | |
1456 (setq temp | |
1457 (widget-value (cadr (assoc (car flag) nnmairix-widgets)))) | |
1458 (if (string= "yes" temp) | |
1459 (cadr flag) | |
1460 (if (string= "no" temp) | |
1461 (concat "-" (cadr flag)))))) | |
1462 '(("seen" "s") ("replied" "r") ("flagged" "f")) "")) | |
1463 (when (not (zerop (length flag))) | |
1464 (push (concat "F:" flag) query))) | |
1465 ;; return query string | |
1466 (mapconcat 'identity query " "))) | |
1467 | |
1468 | |
1469 (defun nnmairix-widget-create-query (&optional values) | |
1470 "Create widgets for creating mairix queries. | |
1471 Fill in VALUES if based on an article." | |
1472 (let (allwidgets) | |
1473 (when (get-buffer nnmairix-customize-query-buffer) | |
1474 (kill-buffer nnmairix-customize-query-buffer)) | |
1475 (switch-to-buffer nnmairix-customize-query-buffer) | |
1476 (kill-all-local-variables) | |
1477 (erase-buffer) | |
1478 (widget-insert "Specify your query for Mairix (check boxes for activating fields):\n\n") | |
1479 (widget-insert "(Whitespaces will be converted to ',' (i.e. AND). Use '/' for OR.)\n\n") | |
1480 ; (make-local-variable 'nnmairix-widgets) | |
1481 (setq nnmairix-widgets (nnmairix-widget-build-editable-fields values)) | |
1482 (when (member 'flags nnmairix-widget-other) | |
1483 (widget-insert "\nFlags:\n Seen: ") | |
1484 (nnmairix-widget-add "seen" | |
1485 'menu-choice | |
1486 :value "ignore" | |
1487 '(item "yes") '(item "no") '(item "ignore")) | |
1488 (widget-insert " Replied: ") | |
1489 (nnmairix-widget-add "replied" | |
1490 'menu-choice | |
1491 :value "ignore" | |
1492 '(item "yes") '(item "no") '(item "ignore")) | |
1493 (widget-insert " Ticked: ") | |
1494 (nnmairix-widget-add "flagged" | |
1495 'menu-choice | |
1496 :value "ignore" | |
1497 '(item "yes") '(item "no") '(item "ignore"))) | |
1498 (when (member 'threads nnmairix-widget-other) | |
1499 (widget-insert "\n") | |
1500 (nnmairix-widget-add "Threads" 'checkbox nil)) | |
1501 (widget-insert " Show full threads\n\n"))) | |
1502 | |
1503 | |
1504 (defun nnmairix-widget-build-editable-fields (values) | |
1505 "Build editable field widgets in `nnmairix-widget-fields-list'. | |
1506 VALUES may contain values for editable fields from current article." | |
1507 ;; how can this be done less ugly? | |
1508 (let ((ret)) | |
1509 (mapc | |
1510 (function | |
1511 (lambda (field) | |
92259
5f51e1a51413
(nnmairix-group-regexp, nnmairix-valid-backends): Convert from free
Glenn Morris <rgm@gnu.org>
parents:
92257
diff
changeset
|
1512 (setq field (car (cddr field))) |
92255 | 1513 (setq ret |
1514 (nconc | |
1515 (list | |
1516 (list | |
1517 (concat "c" field) | |
1518 (widget-create 'checkbox | |
1519 :tag field | |
1520 :notify (lambda (widget &rest ignore) | |
1521 (nnmairix-widget-toggle-activate widget)) | |
1522 nil))) | |
1523 (list | |
1524 (list | |
1525 (concat "e" field) | |
1526 (widget-create 'editable-field | |
1527 :size 60 | |
1528 :format (concat " " field ":" | |
1529 (make-string (- 11 (length field)) ?\ ) | |
1530 "%v") | |
1531 :value (or (cadr (assoc field values)) "")))) | |
1532 ret)) | |
1533 (widget-insert "\n") | |
1534 ;; Deactivate editable field | |
1535 (widget-apply (cadr (nth 1 ret)) :deactivate))) | |
1536 nnmairix-widget-fields-list) | |
1537 ret)) | |
1538 | |
1539 (defun nnmairix-widget-add (name &rest args) | |
1540 "Add a widget NAME with optional ARGS." | |
1541 (push | |
1542 (list name | |
1543 (apply 'widget-create args)) | |
1544 nnmairix-widgets)) | |
1545 | |
1546 (defun nnmairix-widget-toggle-activate (widget) | |
1547 "Toggle activation status of WIDGET dependent on corresponding checkbox value." | |
1548 (let ((field (widget-get widget :tag))) | |
1549 (if (widget-value widget) | |
1550 (widget-apply | |
1551 (cadr (assoc (concat "e" field) nnmairix-widgets)) | |
1552 :activate) | |
1553 (widget-apply | |
1554 (cadr (assoc (concat "e" field) nnmairix-widgets)) | |
1555 :deactivate))) | |
1556 (widget-setup)) | |
1557 | |
1558 (provide 'nnmairix) | |
1559 | |
1560 ;; arch-tag: bb187498-b229-4a55-8c07-6d3f80713e94 | |
1561 ;;; nnmairix.el ends here |