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