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