Mercurial > emacs
comparison lisp/gnus/nnimap.el @ 82951:0fde48feb604
Import Gnus 5.10 from the v5_10 branch of the Gnus repository.
author | Andreas Schwab <schwab@suse.de> |
---|---|
date | Thu, 22 Jul 2004 16:45:51 +0000 |
parents | 5716fec2dbc0 |
children | 5ef78f4dd84f |
comparison
equal
deleted
inserted
replaced
56503:8bbd2323fbf2 | 82951:0fde48feb604 |
---|---|
1 ;;; nnimap.el --- imap backend for Gnus | 1 ;;; nnimap.el --- imap backend for Gnus |
2 | 2 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 |
3 ;; Copyright (C) 1998,1999,2000,01,02,2004 Free Software Foundation, Inc. | 3 ;; Free Software Foundation, Inc. |
4 | 4 |
5 ;; Author: Simon Josefsson <jas@pdc.kth.se> | 5 ;; Author: Simon Josefsson <jas@pdc.kth.se> |
6 ;; Jim Radford <radford@robby.caltech.edu> | 6 ;; Jim Radford <radford@robby.caltech.edu> |
7 ;; Keywords: mail | 7 ;; Keywords: mail |
8 | 8 |
54 ;; o ACAP stuff (perhaps a different project, would be nice to ACAPify | 54 ;; o ACAP stuff (perhaps a different project, would be nice to ACAPify |
55 ;; .newsrc.eld) | 55 ;; .newsrc.eld) |
56 ;; o What about Gnus's article editing, can we support it? NO! | 56 ;; o What about Gnus's article editing, can we support it? NO! |
57 ;; o Use \Draft to support the draft group?? | 57 ;; o Use \Draft to support the draft group?? |
58 ;; o Duplicate suppression | 58 ;; o Duplicate suppression |
59 ;; o Rewrite UID SEARCH UID X as UID FETCH X (UID) for those with slow servers | |
59 | 60 |
60 ;;; Code: | 61 ;;; Code: |
61 | 62 |
62 (eval-and-compile | 63 (require 'imap) |
63 (require 'cl) | |
64 (require 'imap)) | |
65 | |
66 (require 'nnoo) | 64 (require 'nnoo) |
67 (require 'nnmail) | 65 (require 'nnmail) |
68 (require 'nnheader) | 66 (require 'nnheader) |
69 (require 'mm-util) | 67 (require 'mm-util) |
70 (require 'gnus) | 68 (require 'gnus) |
71 (require 'gnus-range) | 69 (require 'gnus-range) |
72 (require 'gnus-start) | 70 (require 'gnus-start) |
73 (require 'gnus-int) | 71 (require 'gnus-int) |
74 | 72 |
73 (eval-when-compile (require 'cl)) | |
74 | |
75 (nnoo-declare nnimap) | 75 (nnoo-declare nnimap) |
76 | 76 |
77 (defconst nnimap-version "nnimap 0.131") | 77 (defconst nnimap-version "nnimap 1.0") |
78 | |
79 (defgroup nnimap nil | |
80 "Reading IMAP mail with Gnus." | |
81 :group 'gnus) | |
78 | 82 |
79 (defvoo nnimap-address nil | 83 (defvoo nnimap-address nil |
80 "Address of physical IMAP server. If nil, use the virtual server's name.") | 84 "Address of physical IMAP server. If nil, use the virtual server's name.") |
81 | 85 |
82 (defvoo nnimap-server-port nil | 86 (defvoo nnimap-server-port nil |
83 "Port number on physical IMAP server. | 87 "Port number on physical IMAP server. |
84 If nil, defaults to 993 for SSL connections and 143 otherwise.") | 88 If nil, defaults to 993 for TLS/SSL connections and 143 otherwise.") |
85 | 89 |
86 ;; Splitting variables | 90 ;; Splitting variables |
87 | 91 |
88 (defvar nnimap-split-crosspost t | 92 (defcustom nnimap-split-crosspost t |
89 "If non-nil, do crossposting if several split methods match the mail. | 93 "If non-nil, do crossposting if several split methods match the mail. |
90 If nil, the first match found will be used.") | 94 If nil, the first match found will be used." |
91 | 95 :group 'nnimap |
92 (defvar nnimap-split-inbox nil | 96 :type 'boolean) |
93 "*Name of mailbox to split mail from. | 97 |
98 (defcustom nnimap-split-inbox nil | |
99 "Name of mailbox to split mail from. | |
94 | 100 |
95 Mail is read from this mailbox and split according to rules in | 101 Mail is read from this mailbox and split according to rules in |
96 `nnimap-split-rules'. | 102 `nnimap-split-rule'. |
97 | 103 |
98 This can be a string or a list of strings.") | 104 This can be a string or a list of strings." |
99 | 105 :group 'nnimap |
100 (defvar nnimap-split-rule nil | 106 :type '(choice (string) |
101 "*Mail will be split according to these rules. | 107 (repeat string))) |
108 | |
109 (define-widget 'nnimap-strict-function 'function | |
110 "This widget only matches values that are functionp. | |
111 | |
112 Warning: This means that a value that is the symbol of a not yet | |
113 loaded function will not match. Use with care." | |
114 :match 'nnimap-strict-function-match) | |
115 | |
116 (defun nnimap-strict-function-match (widget value) | |
117 "Ignoring WIDGET, match if VALUE is a function." | |
118 (functionp value)) | |
119 | |
120 (defcustom nnimap-split-rule nil | |
121 "Mail will be split according to these rules. | |
102 | 122 |
103 Mail is read from mailbox(es) specified in `nnimap-split-inbox'. | 123 Mail is read from mailbox(es) specified in `nnimap-split-inbox'. |
104 | 124 |
105 If you'd like, for instance, one mail group for mail from the | 125 If you'd like, for instance, one mail group for mail from the |
106 \"gnus-imap\" mailing list, one group for junk mail and leave | 126 \"gnus-imap\" mailing list, one group for junk mail and leave |
108 this: | 128 this: |
109 | 129 |
110 \(setq nnimap-split-rule '((\"INBOX.gnus-imap\" \"From:.*gnus-imap\") | 130 \(setq nnimap-split-rule '((\"INBOX.gnus-imap\" \"From:.*gnus-imap\") |
111 (\"INBOX.junk\" \"Subject:.*buy\"))) | 131 (\"INBOX.junk\" \"Subject:.*buy\"))) |
112 | 132 |
113 As you can see, `nnimap-split-rule' is a list of lists, where the first | 133 As you can see, `nnimap-split-rule' is a list of lists, where the |
114 element in each \"rule\" is the name of the IMAP mailbox, and the | 134 first element in each \"rule\" is the name of the IMAP mailbox (or the |
115 second is a regexp that nnimap will try to match on the header to find | 135 symbol `junk' if you want to remove the mail), and the second is a |
116 a fit. | 136 regexp that nnimap will try to match on the header to find a fit. |
117 | 137 |
118 The second element can also be a function. In that case, it will be | 138 The second element can also be a function. In that case, it will be |
119 called narrowed to the headers with the first element of the rule as | 139 called narrowed to the headers with the first element of the rule as |
120 the argument. It should return a non-nil value if it thinks that the | 140 the argument. It should return a non-nil value if it thinks that the |
121 mail belongs in that group. | 141 mail belongs in that group. |
128 even different split rules in different inboxes on the same server, | 148 even different split rules in different inboxes on the same server, |
129 the syntax of this variable have been extended along the lines of: | 149 the syntax of this variable have been extended along the lines of: |
130 | 150 |
131 \(setq nnimap-split-rule | 151 \(setq nnimap-split-rule |
132 '((\"my1server\" (\".*\" ((\"ding\" \"ding@gnus.org\") | 152 '((\"my1server\" (\".*\" ((\"ding\" \"ding@gnus.org\") |
133 (\"junk\" \"From:.*Simon\"))) | 153 (\"junk\" \"From:.*Simon\"))) |
134 (\"my2server\" (\"INBOX\" nnimap-split-fancy)) | 154 (\"my2server\" (\"INBOX\" nnimap-split-fancy)) |
135 (\"my[34]server\" (\".*\" ((\"private\" \"To:.*Simon\") | 155 (\"my[34]server\" (\".*\" ((\"private\" \"To:.*Simon\") |
136 (\"junk\" my-junk-func))))) | 156 (\"junk\" my-junk-func))))) |
137 | 157 |
138 The virtual server name is in fact a regexp, so that the same rules | 158 The virtual server name is in fact a regexp, so that the same rules |
139 may apply to several servers. In the example, the servers | 159 may apply to several servers. In the example, the servers |
140 \"my3server\" and \"my4server\" both use the same rules. Similarly, | 160 \"my3server\" and \"my4server\" both use the same rules. Similarly, |
141 the inbox string is also a regexp. The actual splitting rules are as | 161 the inbox string is also a regexp. The actual splitting rules are as |
142 before, either a function, or a list with group/regexp or | 162 before, either a function, or a list with group/regexp or |
143 group/function elements.") | 163 group/function elements." |
144 | 164 :group 'nnimap |
145 (defvar nnimap-split-predicate "UNSEEN UNDELETED" | 165 :type '(choice :tag "Rule type" |
166 (repeat :menu-tag "Single-server" | |
167 :tag "Single-server list" | |
168 (list (string :tag "Mailbox") | |
169 (choice :tag "Predicate" | |
170 (regexp :tag "A regexp") | |
171 (nnimap-strict-function :tag "A function")))) | |
172 (choice :menu-tag "A function" | |
173 :tag "A function" | |
174 (function-item nnimap-split-fancy) | |
175 (function-item nnmail-split-fancy) | |
176 (nnimap-strict-function :tag "User-defined function")) | |
177 (repeat :menu-tag "Multi-server (extended)" | |
178 :tag "Multi-server list" | |
179 (list (regexp :tag "Server regexp") | |
180 (list (regexp :tag "Incoming Mailbox regexp") | |
181 (repeat :tag "Rules for matching server(s) and mailbox(es)" | |
182 (list (string :tag "Destination mailbox") | |
183 (choice :tag "Predicate" | |
184 (regexp :tag "A Regexp") | |
185 (nnimap-strict-function :tag "A Function"))))))))) | |
186 | |
187 (defcustom nnimap-split-predicate "UNSEEN UNDELETED" | |
146 "The predicate used to find articles to split. | 188 "The predicate used to find articles to split. |
147 If you use another IMAP client to peek on articles but always would | 189 If you use another IMAP client to peek on articles but always would |
148 like nnimap to split them once it's started, you could change this to | 190 like nnimap to split them once it's started, you could change this to |
149 \"UNDELETED\". Other available predicates are available in | 191 \"UNDELETED\". Other available predicates are available in |
150 RFC2060 section 6.4.4.") | 192 RFC2060 section 6.4.4." |
151 | 193 :group 'nnimap |
152 (defvar nnimap-split-fancy nil | 194 :type 'string) |
153 "Like `nnmail-split-fancy', which see.") | 195 |
196 (defcustom nnimap-split-fancy nil | |
197 "Like the variable `nnmail-split-fancy'." | |
198 :group 'nnimap | |
199 :type 'sexp) | |
200 | |
201 (defvar nnimap-split-download-body-default nil | |
202 "Internal variable with default value for `nnimap-split-download-body'.") | |
203 | |
204 (defcustom nnimap-split-download-body 'default | |
205 "Whether to download entire articles during splitting. | |
206 This is generally not required, and will slow things down considerably. | |
207 You may need it if you want to use an advanced splitting function that | |
208 analyses the body before splitting the article. | |
209 If this variable is nil, bodies will not be downloaded; if this | |
210 variable is the symbol `default' the default behaviour is | |
211 used (which currently is nil, unless you use a statistical | |
212 spam.el test); if this variable is another non-nil value bodies | |
213 will be downloaded." | |
214 :group 'nnimap | |
215 :type '(choice (const :tag "Let system decide" deault) | |
216 boolean)) | |
217 | |
218 ;; Performance / bug workaround variables | |
219 | |
220 (defcustom nnimap-close-asynchronous t | |
221 "Close mailboxes asynchronously in `nnimap-close-group'. | |
222 This means that errors cought by nnimap when closing the mailbox will | |
223 not prevent Gnus from updating the group status, which may be harmful. | |
224 However, it increases speed." | |
225 :type 'boolean | |
226 :group 'nnimap) | |
227 | |
228 (defcustom nnimap-dont-close t | |
229 "Never close mailboxes. | |
230 This increases the speed of closing mailboxes (quiting group) but may | |
231 decrease the speed of selecting another mailbox later. Re-selecting | |
232 the same mailbox will be faster though." | |
233 :type 'boolean | |
234 :group 'nnimap) | |
235 | |
236 (defcustom nnimap-retrieve-groups-asynchronous t | |
237 "Send asynchronous STATUS commands for each mailbox before checking mail. | |
238 If you have mailboxes that rarely receives mail, this speeds up new | |
239 mail checking. It works by first sending STATUS commands for each | |
240 mailbox, and then only checking groups which has a modified UIDNEXT | |
241 more carefully for new mail. | |
242 | |
243 In summary, the default is O((1-p)*k+p*n) and changing it to nil makes | |
244 it O(n). If p is small, then the default is probably faster." | |
245 :type 'boolean | |
246 :group 'nnimap) | |
247 | |
248 (defvoo nnimap-need-unselect-to-notice-new-mail nil | |
249 "Unselect mailboxes before looking for new mail in them. | |
250 Some servers seem to need this under some circumstances.") | |
154 | 251 |
155 ;; Authorization / Privacy variables | 252 ;; Authorization / Privacy variables |
156 | 253 |
157 (defvoo nnimap-auth-method nil | 254 (defvoo nnimap-auth-method nil |
158 "Obsolete.") | 255 "Obsolete.") |
163 The default, nil, will try to use the \"best\" method the server can | 260 The default, nil, will try to use the \"best\" method the server can |
164 handle. | 261 handle. |
165 | 262 |
166 Change this if | 263 Change this if |
167 | 264 |
168 1) you want to connect with SSL. The SSL integration with IMAP is | 265 1) you want to connect with TLS/SSL. The TLS/SSL integration |
169 brain-dead so you'll have to tell it specifically. | 266 with IMAP is suboptimal so you'll have to tell it |
267 specifically. | |
170 | 268 |
171 2) your server is more capable than your environment -- i.e. your | 269 2) your server is more capable than your environment -- i.e. your |
172 server accept Kerberos login's but you haven't installed the | 270 server accept Kerberos login's but you haven't installed the |
173 `imtest' program or your machine isn't configured for Kerberos. | 271 `imtest' program or your machine isn't configured for Kerberos. |
174 | 272 |
175 Possible choices: kerberos4, ssl, network") | 273 Possible choices: gssapi, kerberos4, starttls, tls, ssl, network, shell. |
274 See also `imap-streams' and `imap-stream-alist'.") | |
176 | 275 |
177 (defvoo nnimap-authenticator nil | 276 (defvoo nnimap-authenticator nil |
178 "How nnimap authenticate itself to the server. | 277 "How nnimap authenticate itself to the server. |
179 | 278 |
180 The default, nil, will try to use the \"best\" method the server can | 279 The default, nil, will try to use the \"best\" method the server can |
184 if your server is more capable than your environment -- i.e. you | 283 if your server is more capable than your environment -- i.e. you |
185 connect to a server that accept Kerberos login's but you haven't | 284 connect to a server that accept Kerberos login's but you haven't |
186 installed the `imtest' program or your machine isn't configured for | 285 installed the `imtest' program or your machine isn't configured for |
187 Kerberos. | 286 Kerberos. |
188 | 287 |
189 Possible choices: kerberos4, cram-md5, login, anonymous.") | 288 Possible choices: gssapi, kerberos4, digest-md5, cram-md5, login, anonymous. |
289 See also `imap-authenticators' and `imap-authenticator-alist'") | |
190 | 290 |
191 (defvoo nnimap-directory (nnheader-concat gnus-directory "overview/") | 291 (defvoo nnimap-directory (nnheader-concat gnus-directory "overview/") |
192 "Directory to keep NOV cache files for nnimap groups. | 292 "Directory to keep NOV cache files for nnimap groups. |
193 See also `nnimap-nov-file-name'.") | 293 See also `nnimap-nov-file-name'.") |
194 | 294 |
201 `nnmail-use-long-file-names' is nil") | 301 `nnmail-use-long-file-names' is nil") |
202 | 302 |
203 (defvoo nnimap-nov-file-name-suffix ".novcache" | 303 (defvoo nnimap-nov-file-name-suffix ".novcache" |
204 "Suffix for NOV cache base filename.") | 304 "Suffix for NOV cache base filename.") |
205 | 305 |
206 (defvoo nnimap-nov-is-evil nil | 306 (defvoo nnimap-nov-is-evil gnus-agent |
207 "If non-nil, nnimap will never generate or use a local nov database for this backend. | 307 "If non-nil, never generate or use a local nov database for this backend. |
208 Using nov databases will speed up header fetching considerably. | 308 Using nov databases should speed up header fetching considerably. |
309 However, it will invoke a UID SEARCH UID command on the server, and | |
310 some servers implement this command inefficiently by opening each and | |
311 every message in the group, thus making it quite slow. | |
209 Unlike other backends, you do not need to take special care if you | 312 Unlike other backends, you do not need to take special care if you |
210 flip this variable.") | 313 flip this variable.") |
211 | 314 |
212 (defvoo nnimap-expunge-on-close 'always ; 'ask, 'never | 315 (defvoo nnimap-expunge-on-close 'always ; 'ask, 'never |
213 "Whether to expunge a group when it is closed. | 316 "Whether to expunge a group when it is closed. |
236 | 339 |
237 There are two wildcards * and %. * matches everything, % matches | 340 There are two wildcards * and %. * matches everything, % matches |
238 everything in the current hierarchy.") | 341 everything in the current hierarchy.") |
239 | 342 |
240 (defvoo nnimap-news-groups nil | 343 (defvoo nnimap-news-groups nil |
241 "IMAP support a news-like mode, also known as bulletin board mode, where replies is sent via IMAP instead of SMTP. | 344 "IMAP support a news-like mode, also known as bulletin board mode, |
345 where replies is sent via IMAP instead of SMTP. | |
242 | 346 |
243 This variable should contain a regexp matching groups where you wish | 347 This variable should contain a regexp matching groups where you wish |
244 replies to be stored to the mailbox directly. | 348 replies to be stored to the mailbox directly. |
245 | 349 |
246 Example: | 350 Example: |
250 | 354 |
251 Note that there is nothing technically different between mail-like and | 355 Note that there is nothing technically different between mail-like and |
252 news-like mailboxes. If you wish to have a group with todo items or | 356 news-like mailboxes. If you wish to have a group with todo items or |
253 similar which you wouldn't want to set up a mailing list for, you can | 357 similar which you wouldn't want to set up a mailing list for, you can |
254 use this to make replies go directly to the group.") | 358 use this to make replies go directly to the group.") |
359 | |
360 (defvoo nnimap-expunge-search-string "UID %s NOT SINCE %s" | |
361 "IMAP search command to use for articles that are to be expired. | |
362 The first %s is replaced by a UID set of articles to search on, | |
363 and the second %s is replaced by a date criterium. | |
364 | |
365 One useful (and perhaps the only useful) value to change this to would | |
366 be `UID %s NOT SENTSINCE %s' to make nnimap use the Date: header | |
367 instead of the internal date of messages. See section 6.4.4 of RFC | |
368 2060 for more information on valid strings.") | |
369 | |
370 (defvoo nnimap-importantize-dormant t | |
371 "If non-nil, mark \"dormant\" articles as \"ticked\" for other IMAP clients. | |
372 Note that within Gnus, dormant articles will still (only) be | |
373 marked as ticked. This is to make \"dormant\" articles stand out, | |
374 just like \"ticked\" articles, in other IMAP clients.") | |
255 | 375 |
256 (defvoo nnimap-server-address nil | 376 (defvoo nnimap-server-address nil |
257 "Obsolete. Use `nnimap-address'.") | 377 "Obsolete. Use `nnimap-address'.") |
258 | 378 |
259 (defcustom nnimap-authinfo-file "~/.authinfo" | 379 (defcustom nnimap-authinfo-file "~/.authinfo" |
269 (cons :format "%v" | 389 (cons :format "%v" |
270 (const :format "" "login") | 390 (const :format "" "login") |
271 (string :format "Login: %v")) | 391 (string :format "Login: %v")) |
272 (cons :format "%v" | 392 (cons :format "%v" |
273 (const :format "" "password") | 393 (const :format "" "password") |
274 (string :format "Password: %v")))))) | 394 (string :format "Password: %v"))))))) |
275 :group 'nnimap) | |
276 | 395 |
277 (defcustom nnimap-prune-cache t | 396 (defcustom nnimap-prune-cache t |
278 "If non-nil, nnimap check whether articles still exist on server before using data stored in NOV cache." | 397 "If non-nil, nnimap check whether articles still exist on server before using data stored in NOV cache." |
279 :type 'boolean | 398 :type 'boolean) |
280 :group 'nnimap) | |
281 | 399 |
282 (defvar nnimap-request-list-method 'imap-mailbox-list | 400 (defvar nnimap-request-list-method 'imap-mailbox-list |
283 "Method to use to request a list of all folders from the server. | 401 "Method to use to request a list of all folders from the server. |
284 If this is 'imap-mailbox-lsub, then use a server-side subscription list to | 402 If this is 'imap-mailbox-lsub, then use a server-side subscription list to |
285 restrict visible folders.") | 403 restrict visible folders.") |
286 | 404 |
405 (defcustom nnimap-debug nil | |
406 "If non-nil, random debug spews are placed in *nnimap-debug* buffer." | |
407 :group 'nnimap | |
408 :type 'boolean) | |
409 | |
287 ;; Internal variables: | 410 ;; Internal variables: |
288 | 411 |
289 (defvar nnimap-debug nil | 412 (defvar nnimap-debug-buffer "*nnimap-debug*") |
290 "Name of buffer to record debugging info. | 413 (defvar nnimap-mailbox-info (gnus-make-hashtable 997)) |
291 For example: (setq nnimap-debug \"*nnimap-debug*\")") | |
292 (defvar nnimap-current-move-server nil) | 414 (defvar nnimap-current-move-server nil) |
293 (defvar nnimap-current-move-group nil) | 415 (defvar nnimap-current-move-group nil) |
294 (defvar nnimap-current-move-article nil) | 416 (defvar nnimap-current-move-article nil) |
295 (defvar nnimap-length) | 417 (defvar nnimap-length) |
296 (defvar nnimap-progress-chars '(?| ?/ ?- ?\\)) | 418 (defvar nnimap-progress-chars '(?| ?/ ?- ?\\)) |
297 (defvar nnimap-progress-how-often 20) | 419 (defvar nnimap-progress-how-often 20) |
298 (defvar nnimap-counter) | 420 (defvar nnimap-counter) |
299 (defvar nnimap-callback-callback-function nil | |
300 "Gnus callback the nnimap asynchronous callback should call.") | |
301 (defvar nnimap-callback-buffer nil | |
302 "Which buffer the asynchronous article prefetch callback should work in.") | |
303 (defvar nnimap-server-buffer-alist nil) ;; Map server name to buffers. | 421 (defvar nnimap-server-buffer-alist nil) ;; Map server name to buffers. |
304 (defvar nnimap-current-server nil) ;; Current server | 422 (defvar nnimap-current-server nil) ;; Current server |
305 (defvar nnimap-server-buffer nil) ;; Current servers' buffer | 423 (defvar nnimap-server-buffer nil) ;; Current servers' buffer |
306 | 424 |
307 | 425 |
308 | 426 |
309 (nnoo-define-basics nnimap) | 427 (nnoo-define-basics nnimap) |
310 | 428 |
326 group (gnus-server-to-method | 444 group (gnus-server-to-method |
327 (format "nnimap:%s" server)))) | 445 (format "nnimap:%s" server)))) |
328 (new-uidvalidity (imap-mailbox-get 'uidvalidity)) | 446 (new-uidvalidity (imap-mailbox-get 'uidvalidity)) |
329 (old-uidvalidity (gnus-group-get-parameter gnusgroup 'uidvalidity)) | 447 (old-uidvalidity (gnus-group-get-parameter gnusgroup 'uidvalidity)) |
330 (dir (file-name-as-directory (expand-file-name nnimap-directory))) | 448 (dir (file-name-as-directory (expand-file-name nnimap-directory))) |
331 (nameuid (nnheader-translate-file-chars | 449 (nameuid (nnheader-translate-file-chars |
332 (concat nnimap-nov-file-name | 450 (concat nnimap-nov-file-name |
333 (if (equal server "") | 451 (if (equal server "") |
334 "unnamed" | 452 "unnamed" |
335 server) "." group "." old-uidvalidity | 453 server) "." group "." old-uidvalidity |
336 nnimap-nov-file-name-suffix) t)) | 454 nnimap-nov-file-name-suffix) t)) |
337 (file (if (or nnmail-use-long-file-names | 455 (file (if (or nnmail-use-long-file-names |
338 (file-exists-p (expand-file-name nameuid dir))) | 456 (file-exists-p (expand-file-name nameuid dir))) |
339 (expand-file-name nameuid dir) | 457 (expand-file-name nameuid dir) |
340 (expand-file-name | 458 (expand-file-name |
341 (mm-encode-coding-string | 459 (mm-encode-coding-string |
342 (nnheader-replace-chars-in-string nameuid ?. ?/) | 460 (nnheader-replace-chars-in-string nameuid ?. ?/) |
352 t))) | 470 t))) |
353 | 471 |
354 (defun nnimap-before-find-minmax-bugworkaround () | 472 (defun nnimap-before-find-minmax-bugworkaround () |
355 "Function called before iterating through mailboxes with | 473 "Function called before iterating through mailboxes with |
356 `nnimap-find-minmax-uid'." | 474 `nnimap-find-minmax-uid'." |
357 ;; XXX this is for UoW imapd problem, it doesn't notice new mail in | 475 (when nnimap-need-unselect-to-notice-new-mail |
358 ;; currently selected mailbox without a re-select/examine. | 476 ;; XXX this is for UoW imapd problem, it doesn't notice new mail in |
359 (or (null (imap-current-mailbox nnimap-server-buffer)) | 477 ;; currently selected mailbox without a re-select/examine. |
360 (imap-mailbox-unselect nnimap-server-buffer))) | 478 (or (null (imap-current-mailbox nnimap-server-buffer)) |
479 (imap-mailbox-unselect nnimap-server-buffer)))) | |
361 | 480 |
362 (defun nnimap-find-minmax-uid (group &optional examine) | 481 (defun nnimap-find-minmax-uid (group &optional examine) |
363 "Find lowest and highest active article number in GROUP. | 482 "Find lowest and highest active article number in GROUP. |
364 If EXAMINE is non-nil the group is selected read-only." | 483 If EXAMINE is non-nil the group is selected read-only." |
365 (with-current-buffer nnimap-server-buffer | 484 (with-current-buffer nnimap-server-buffer |
366 (when (imap-mailbox-select group examine) | 485 (when (or (string= group (imap-current-mailbox)) |
486 (imap-mailbox-select group examine)) | |
367 (let (minuid maxuid) | 487 (let (minuid maxuid) |
368 (when (> (imap-mailbox-get 'exists) 0) | 488 (when (> (imap-mailbox-get 'exists) 0) |
369 (imap-fetch "1,*" "UID" nil 'nouidfetch) | 489 (imap-fetch "1,*" "UID" nil 'nouidfetch) |
370 (imap-message-map (lambda (uid Uid) | 490 (imap-message-map (lambda (uid Uid) |
371 (setq minuid (if minuid (min minuid uid) uid) | 491 (setq minuid (if minuid (min minuid uid) uid) |
381 imap-current-mailbox | 501 imap-current-mailbox |
382 (if (imap-mailbox-select group) | 502 (if (imap-mailbox-select group) |
383 (if (or (nnimap-verify-uidvalidity | 503 (if (or (nnimap-verify-uidvalidity |
384 group (or server nnimap-current-server)) | 504 group (or server nnimap-current-server)) |
385 (zerop (imap-mailbox-get 'exists group)) | 505 (zerop (imap-mailbox-get 'exists group)) |
506 t ;; for OGnus to see if ignoring uidvalidity | |
507 ;; changes has any bad effects. | |
386 (yes-or-no-p | 508 (yes-or-no-p |
387 (format | 509 (format |
388 "nnimap: Group %s is not uidvalid. Continue? " group))) | 510 "nnimap: Group %s is not uidvalid. Continue? " group))) |
389 imap-current-mailbox | 511 imap-current-mailbox |
390 (imap-mailbox-unselect) | 512 (imap-mailbox-unselect) |
426 chars (imap-message-get imap-current-message 'RFC822.SIZE))) | 548 chars (imap-message-get imap-current-message 'RFC822.SIZE))) |
427 (nnheader-insert-nov | 549 (nnheader-insert-nov |
428 (with-temp-buffer | 550 (with-temp-buffer |
429 (buffer-disable-undo) | 551 (buffer-disable-undo) |
430 (insert headers) | 552 (insert headers) |
431 (nnheader-ms-strip-cr) | 553 (let ((head (nnheader-parse-naked-head))) |
432 (nnheader-fold-continuation-lines) | |
433 (subst-char-in-region (point-min) (point-max) ?\t ? ) | |
434 (let ((head (nnheader-parse-head 'naked))) | |
435 (mail-header-set-number head uid) | 554 (mail-header-set-number head uid) |
436 (mail-header-set-chars head chars) | 555 (mail-header-set-chars head chars) |
437 (mail-header-set-lines head lines) | 556 (mail-header-set-lines head lines) |
438 (mail-header-set-xref | 557 (mail-header-set-xref |
439 head (format "%s %s:%d" (system-name) mbx uid)) | 558 head (format "%s %s:%d" (system-name) mbx uid)) |
454 1) | 573 1) |
455 (1- (car articles))))) | 574 (1- (car articles))))) |
456 articles))))) | 575 articles))))) |
457 (mapcar (lambda (msgid) | 576 (mapcar (lambda (msgid) |
458 (imap-search | 577 (imap-search |
459 (format "HEADER Message-Id %s" msgid))) | 578 (format "HEADER Message-Id \"%s\"" msgid))) |
460 articles)))) | 579 articles)))) |
461 | 580 |
462 (defun nnimap-group-overview-filename (group server) | 581 (defun nnimap-group-overview-filename (group server) |
463 "Make file name for GROUP on SERVER." | 582 "Make file name for GROUP on SERVER." |
464 (let* ((dir (file-name-as-directory (expand-file-name nnimap-directory))) | 583 (let* ((dir (file-name-as-directory (expand-file-name nnimap-directory))) |
465 (uidvalidity (gnus-group-get-parameter | 584 (uidvalidity (gnus-group-get-parameter |
466 (gnus-group-prefixed-name | 585 (gnus-group-prefixed-name |
467 group (gnus-server-to-method | 586 group (gnus-server-to-method |
468 (format "nnimap:%s" server))) | 587 (format "nnimap:%s" server))) |
469 'uidvalidity)) | 588 'uidvalidity)) |
470 (name (nnheader-translate-file-chars | 589 (name (nnheader-translate-file-chars |
471 (concat nnimap-nov-file-name | 590 (concat nnimap-nov-file-name |
472 (if (equal server "") | 591 (if (equal server "") |
473 "unnamed" | 592 "unnamed" |
474 server) "." group nnimap-nov-file-name-suffix) t)) | 593 server) "." group nnimap-nov-file-name-suffix) t)) |
475 (nameuid (nnheader-translate-file-chars | 594 (nameuid (nnheader-translate-file-chars |
476 (concat nnimap-nov-file-name | 595 (concat nnimap-nov-file-name |
477 (if (equal server "") | 596 (if (equal server "") |
478 "unnamed" | 597 "unnamed" |
479 server) "." group "." uidvalidity | 598 server) "." group "." uidvalidity |
480 nnimap-nov-file-name-suffix) t)) | 599 nnimap-nov-file-name-suffix) t)) |
481 (oldfile (if (or nnmail-use-long-file-names | 600 (oldfile (if (or nnmail-use-long-file-names |
482 (file-exists-p (expand-file-name name dir))) | 601 (file-exists-p (expand-file-name name dir))) |
483 (expand-file-name name dir) | 602 (expand-file-name name dir) |
484 (expand-file-name | 603 (expand-file-name |
485 (mm-encode-coding-string | 604 (mm-encode-coding-string |
486 (nnheader-replace-chars-in-string name ?. ?/) | 605 (nnheader-replace-chars-in-string name ?. ?/) |
487 nnmail-pathname-coding-system) | 606 nnmail-pathname-coding-system) |
488 dir))) | 607 dir))) |
489 (newfile (if (or nnmail-use-long-file-names | 608 (newfile (if (or nnmail-use-long-file-names |
490 (file-exists-p (expand-file-name nameuid dir))) | 609 (file-exists-p (expand-file-name nameuid dir))) |
491 (expand-file-name nameuid dir) | 610 (expand-file-name nameuid dir) |
492 (expand-file-name | 611 (expand-file-name |
493 (mm-encode-coding-string | 612 (mm-encode-coding-string |
494 (nnheader-replace-chars-in-string nameuid ?. ?/) | 613 (nnheader-replace-chars-in-string nameuid ?. ?/) |
495 nnmail-pathname-coding-system) | 614 nnmail-pathname-coding-system) |
496 dir)))) | 615 dir)))) |
497 (when (and (file-exists-p oldfile) (not (file-exists-p newfile))) | 616 (when (and (file-exists-p oldfile) (not (file-exists-p newfile))) |
498 (message "nnimap: Upgrading novcache filename...") | 617 (message "nnimap: Upgrading novcache filename...") |
499 (sit-for 1) | 618 (sit-for 1) |
500 (gnus-make-directory (file-name-directory newfile)) | 619 (gnus-make-directory (file-name-directory newfile)) |
501 (unless (ignore-errors (rename-file oldfile newfile) t) | 620 (unless (ignore-errors (rename-file oldfile newfile) t) |
538 (format "RFC822.HEADER.LINES %s)" headers))))) | 657 (format "RFC822.HEADER.LINES %s)" headers))))) |
539 (and (numberp nnmail-large-newsgroup) | 658 (and (numberp nnmail-large-newsgroup) |
540 (> nnimap-length nnmail-large-newsgroup) | 659 (> nnimap-length nnmail-large-newsgroup) |
541 (nnheader-message 6 "nnimap: Retrieving headers...done"))))) | 660 (nnheader-message 6 "nnimap: Retrieving headers...done"))))) |
542 | 661 |
543 (defun nnimap-use-nov-p (group server) | 662 (defun nnimap-dont-use-nov-p (group server) |
544 (or gnus-nov-is-evil nnimap-nov-is-evil | 663 (or gnus-nov-is-evil nnimap-nov-is-evil |
545 (unless (and (gnus-make-directory | 664 (unless (and (gnus-make-directory |
546 (file-name-directory | 665 (file-name-directory |
547 (nnimap-group-overview-filename group server))) | 666 (nnimap-group-overview-filename group server))) |
548 (file-writable-p | 667 (file-writable-p |
552 | 671 |
553 (deffoo nnimap-retrieve-headers (articles &optional group server fetch-old) | 672 (deffoo nnimap-retrieve-headers (articles &optional group server fetch-old) |
554 (when (nnimap-possibly-change-group group server) | 673 (when (nnimap-possibly-change-group group server) |
555 (with-current-buffer nntp-server-buffer | 674 (with-current-buffer nntp-server-buffer |
556 (erase-buffer) | 675 (erase-buffer) |
557 (if (nnimap-use-nov-p group server) | 676 (if (nnimap-dont-use-nov-p group server) |
558 (nnimap-retrieve-headers-from-server | 677 (nnimap-retrieve-headers-from-server |
559 (gnus-compress-sequence articles) group server) | 678 (gnus-compress-sequence articles) group server) |
560 (let (uids cached low high) | 679 (let (uids cached low high) |
561 (when (setq uids (nnimap-retrieve-which-headers articles fetch-old) | 680 (when (setq uids (nnimap-retrieve-which-headers articles fetch-old) |
562 low (car uids) | 681 low (car uids) |
575 (cons (1+ (cdr cached)) high) group server)) | 694 (cons (1+ (cdr cached)) high) group server)) |
576 (when nnimap-prune-cache | 695 (when nnimap-prune-cache |
577 ;; remove nov's for articles which has expired on server | 696 ;; remove nov's for articles which has expired on server |
578 (goto-char (point-min)) | 697 (goto-char (point-min)) |
579 (dolist (uid (gnus-set-difference articles uids)) | 698 (dolist (uid (gnus-set-difference articles uids)) |
580 (when (re-search-forward (format "^%d\t" uid) nil t) | 699 (when (re-search-forward (format "^%d\t" uid) nil t) |
581 (gnus-delete-line))))) | 700 (gnus-delete-line))))) |
582 ;; nothing cached, fetch whole range from server | 701 ;; nothing cached, fetch whole range from server |
583 (nnimap-retrieve-headers-from-server | 702 (nnimap-retrieve-headers-from-server |
584 (cons low high) group server)) | 703 (cons low high) group server)) |
585 (when (buffer-modified-p) | 704 (when (buffer-modified-p) |
586 (nnmail-write-region | 705 (nnmail-write-region |
599 (nnheader-report 'nnimap "Server %s is not IMAP4 compliant" server)) | 718 (nnheader-report 'nnimap "Server %s is not IMAP4 compliant" server)) |
600 (let* ((list (gnus-parse-netrc nnimap-authinfo-file)) | 719 (let* ((list (gnus-parse-netrc nnimap-authinfo-file)) |
601 (port (if nnimap-server-port | 720 (port (if nnimap-server-port |
602 (int-to-string nnimap-server-port) | 721 (int-to-string nnimap-server-port) |
603 "imap")) | 722 "imap")) |
604 (alist (gnus-netrc-machine list (or nnimap-server-address | 723 (alist (or (gnus-netrc-machine list server port "imap") |
605 nnimap-address server) | 724 (gnus-netrc-machine list |
606 port "imap")) | 725 (or nnimap-server-address |
726 nnimap-address) | |
727 port "imap"))) | |
607 (user (gnus-netrc-get alist "login")) | 728 (user (gnus-netrc-get alist "login")) |
608 (passwd (gnus-netrc-get alist "password"))) | 729 (passwd (gnus-netrc-get alist "password"))) |
609 (if (imap-authenticate user passwd nnimap-server-buffer) | 730 (if (imap-authenticate user passwd nnimap-server-buffer) |
610 (prog1 | 731 (prog1 |
611 (push (list server nnimap-server-buffer) | 732 (push (list server nnimap-server-buffer) |
627 (if (assq 'nnimap-server-address defs) | 748 (if (assq 'nnimap-server-address defs) |
628 (push (list 'nnimap-address | 749 (push (list 'nnimap-address |
629 (cadr (assq 'nnimap-server-address defs))) defs) | 750 (cadr (assq 'nnimap-server-address defs))) defs) |
630 (push (list 'nnimap-address server) defs))) | 751 (push (list 'nnimap-address server) defs))) |
631 (nnoo-change-server 'nnimap server defs) | 752 (nnoo-change-server 'nnimap server defs) |
753 (or nnimap-server-buffer | |
754 (setq nnimap-server-buffer (cadr (assq 'nnimap-server-buffer defs)))) | |
632 (with-current-buffer (get-buffer-create nnimap-server-buffer) | 755 (with-current-buffer (get-buffer-create nnimap-server-buffer) |
633 (nnoo-change-server 'nnimap server defs)) | 756 (nnoo-change-server 'nnimap server defs)) |
634 (or (and nnimap-server-buffer | 757 (or (and nnimap-server-buffer |
635 (imap-opened nnimap-server-buffer)) | 758 (imap-opened nnimap-server-buffer) |
759 (if (with-current-buffer nnimap-server-buffer | |
760 (memq imap-state '(auth select examine))) | |
761 t | |
762 (imap-close nnimap-server-buffer) | |
763 (nnimap-open-connection server))) | |
636 (nnimap-open-connection server)))) | 764 (nnimap-open-connection server)))) |
637 | 765 |
638 (deffoo nnimap-server-opened (&optional server) | 766 (deffoo nnimap-server-opened (&optional server) |
639 "Whether SERVER is opened. | 767 "Whether SERVER is opened. |
640 If SERVER is the current virtual server, and the connection to the | 768 If SERVER is the current virtual server, and the connection to the |
672 "This function returns the last error message from server." | 800 "This function returns the last error message from server." |
673 (when (nnimap-possibly-change-server server) | 801 (when (nnimap-possibly-change-server server) |
674 (nnoo-status-message 'nnimap server))) | 802 (nnoo-status-message 'nnimap server))) |
675 | 803 |
676 (defun nnimap-demule (string) | 804 (defun nnimap-demule (string) |
677 ;; BEWARE: we used to use string-as-multibyte here which is braindead | 805 (funcall (if (and (fboundp 'string-as-multibyte) |
678 ;; because it will turn accidental emacs-mule-valid byte sequences | 806 (subrp (symbol-function 'string-as-multibyte))) |
679 ;; into multibyte chars. --Stef | 807 'string-as-multibyte |
680 (funcall (if (and (fboundp 'string-to-multibyte) | |
681 (subrp (symbol-function 'string-to-multibyte))) | |
682 'string-to-multibyte | |
683 'identity) | 808 'identity) |
684 (or string ""))) | 809 (or string ""))) |
685 | 810 |
686 (defun nnimap-callback () | 811 (defun nnimap-make-callback (article gnus-callback buffer) |
687 (remove-hook 'imap-fetch-data-hook 'nnimap-callback) | 812 "Return a callback function." |
688 (with-current-buffer nnimap-callback-buffer | 813 `(lambda () |
689 (insert | 814 (nnimap-callback ,article ,gnus-callback ,buffer))) |
690 (with-current-buffer nnimap-server-buffer | 815 |
691 (nnimap-demule | 816 (defun nnimap-callback (article gnus-callback buffer) |
692 (if (imap-capability 'IMAP4rev1) | 817 (when (eq article (imap-current-message)) |
693 ;; xxx don't just use car? alist doesn't contain | 818 (remove-hook 'imap-fetch-data-hook |
694 ;; anything else now, but it might... | 819 (nnimap-make-callback article gnus-callback buffer)) |
695 (nth 2 (car (imap-message-get (imap-current-message) 'BODYDETAIL))) | 820 (with-current-buffer buffer |
696 (imap-message-get (imap-current-message) 'RFC822))))) | 821 (insert |
697 (nnheader-ms-strip-cr) | 822 (with-current-buffer nnimap-server-buffer |
698 (funcall nnimap-callback-callback-function t))) | 823 (nnimap-demule |
824 (if (imap-capability 'IMAP4rev1) | |
825 ;; xxx don't just use car? alist doesn't contain | |
826 ;; anything else now, but it might... | |
827 (nth 2 (car (imap-message-get article 'BODYDETAIL))) | |
828 (imap-message-get article 'RFC822))))) | |
829 (nnheader-ms-strip-cr) | |
830 (funcall gnus-callback t)))) | |
699 | 831 |
700 (defun nnimap-request-article-part (article part prop &optional | 832 (defun nnimap-request-article-part (article part prop &optional |
701 group server to-buffer detail) | 833 group server to-buffer detail) |
702 (when (nnimap-possibly-change-group group server) | 834 (when (nnimap-possibly-change-group group server) |
703 (let ((article (if (stringp article) | 835 (let ((article (if (stringp article) |
704 (car-safe (imap-search | 836 (car-safe (imap-search |
705 (format "HEADER Message-Id %s" article) | 837 (format "HEADER Message-Id \"%s\"" article) |
706 nnimap-server-buffer)) | 838 nnimap-server-buffer)) |
707 article))) | 839 article))) |
708 (when article | 840 (when article |
709 (gnus-message 10 "nnimap: Fetching (part of) article %d..." article) | 841 (gnus-message 10 "nnimap: Fetching (part of) article %d from %s..." |
842 article (or group imap-current-mailbox | |
843 gnus-newsgroup-name)) | |
710 (if (not nnheader-callback-function) | 844 (if (not nnheader-callback-function) |
711 (with-current-buffer (or to-buffer nntp-server-buffer) | 845 (with-current-buffer (or to-buffer nntp-server-buffer) |
712 (erase-buffer) | 846 (erase-buffer) |
713 (let ((data (imap-fetch article part prop nil | 847 (let ((data (imap-fetch article part prop nil |
714 nnimap-server-buffer))) | 848 nnimap-server-buffer))) |
715 (insert (nnimap-demule (if detail | 849 (insert (nnimap-demule (if detail |
716 (nth 2 (car data)) | 850 (nth 2 (car data)) |
717 data)))) | 851 data)))) |
718 (nnheader-ms-strip-cr) | 852 (nnheader-ms-strip-cr) |
719 (gnus-message 10 "nnimap: Fetching (part of) article %d...done" | 853 (gnus-message |
720 article) | 854 10 "nnimap: Fetching (part of) article %d from %s...done" |
855 article (or group imap-current-mailbox gnus-newsgroup-name)) | |
721 (if (bobp) | 856 (if (bobp) |
722 (nnheader-report 'nnimap "No such article: %s" | 857 (nnheader-report 'nnimap "No such article %d in %s: %s" |
858 article (or group imap-current-mailbox | |
859 gnus-newsgroup-name) | |
723 (imap-error-text nnimap-server-buffer)) | 860 (imap-error-text nnimap-server-buffer)) |
724 (cons group article))) | 861 (cons group article))) |
725 (add-hook 'imap-fetch-data-hook 'nnimap-callback) | 862 (add-hook 'imap-fetch-data-hook |
726 (setq nnimap-callback-callback-function nnheader-callback-function | 863 (nnimap-make-callback article |
727 nnimap-callback-buffer nntp-server-buffer) | 864 nnheader-callback-function |
865 nntp-server-buffer)) | |
728 (imap-fetch-asynch article part nil nnimap-server-buffer) | 866 (imap-fetch-asynch article part nil nnimap-server-buffer) |
729 (cons group article)))))) | 867 (cons group article)))))) |
730 | 868 |
731 (deffoo nnimap-asynchronous-p () | 869 (deffoo nnimap-asynchronous-p () |
732 t) | 870 t) |
770 (max 1 (or (nth 1 info) 1)) | 908 (max 1 (or (nth 1 info) 1)) |
771 (or (nth 2 info) 0) group) | 909 (or (nth 2 info) 0) group) |
772 (nnheader-report 'nnimap "Group %s selected" group) | 910 (nnheader-report 'nnimap "Group %s selected" group) |
773 t))))) | 911 t))))) |
774 | 912 |
913 (defun nnimap-update-unseen (group &optional server) | |
914 "Update the unseen count in `nnimap-mailbox-info'." | |
915 (gnus-sethash | |
916 (gnus-group-prefixed-name group server) | |
917 (let ((old (gnus-gethash-safe (gnus-group-prefixed-name group server) | |
918 nnimap-mailbox-info))) | |
919 (list (nth 0 old) (nth 1 old) | |
920 (imap-mailbox-status group 'unseen nnimap-server-buffer) | |
921 (nth 3 old))) | |
922 nnimap-mailbox-info)) | |
923 | |
775 (defun nnimap-close-group (group &optional server) | 924 (defun nnimap-close-group (group &optional server) |
776 (with-current-buffer nnimap-server-buffer | 925 (with-current-buffer nnimap-server-buffer |
777 (when (and (imap-opened) | 926 (when (and (imap-opened) |
778 (nnimap-possibly-change-group group server)) | 927 (nnimap-possibly-change-group group server)) |
928 (nnimap-update-unseen group server) | |
779 (case nnimap-expunge-on-close | 929 (case nnimap-expunge-on-close |
780 ('always (imap-mailbox-expunge) | 930 (always (progn |
781 (imap-mailbox-close)) | 931 (imap-mailbox-expunge nnimap-close-asynchronous) |
782 ('ask (if (and (imap-search "DELETED") | 932 (unless nnimap-dont-close |
783 (gnus-y-or-n-p (format | 933 (imap-mailbox-close nnimap-close-asynchronous)))) |
784 "Expunge articles in group `%s'? " | 934 (ask (if (and (imap-search "DELETED") |
785 imap-current-mailbox))) | 935 (gnus-y-or-n-p (format "Expunge articles in group `%s'? " |
786 (progn (imap-mailbox-expunge) | 936 imap-current-mailbox))) |
787 (imap-mailbox-close)) | 937 (progn |
788 (imap-mailbox-unselect))) | 938 (imap-mailbox-expunge nnimap-close-asynchronous) |
939 (unless nnimap-dont-close | |
940 (imap-mailbox-close nnimap-close-asynchronous))) | |
941 (imap-mailbox-unselect))) | |
789 (t (imap-mailbox-unselect))) | 942 (t (imap-mailbox-unselect))) |
790 (not imap-current-mailbox)))) | 943 (not imap-current-mailbox)))) |
791 | 944 |
792 (defun nnimap-pattern-to-list-arguments (pattern) | 945 (defun nnimap-pattern-to-list-arguments (pattern) |
793 (mapcar (lambda (p) | 946 (mapcar (lambda (p) |
810 (cdr pattern) (car pattern))) | 963 (cdr pattern) (car pattern))) |
811 (or (member "\\NoSelect" (imap-mailbox-get 'list-flags mbx)) | 964 (or (member "\\NoSelect" (imap-mailbox-get 'list-flags mbx)) |
812 (let ((info (nnimap-find-minmax-uid mbx 'examine))) | 965 (let ((info (nnimap-find-minmax-uid mbx 'examine))) |
813 (when info | 966 (when info |
814 (with-current-buffer nntp-server-buffer | 967 (with-current-buffer nntp-server-buffer |
815 (insert (format "\"%s\" %d %d y\n" | 968 (insert (format "\"%s\" %d %d y\n" |
816 mbx (or (nth 2 info) 0) | 969 mbx (or (nth 2 info) 0) |
817 (max 1 (or (nth 1 info) 1))))))))))) | 970 (max 1 (or (nth 1 info) 1))))))))))) |
818 (gnus-message 5 "nnimap: Generating active list%s...done" | 971 (gnus-message 5 "nnimap: Generating active list%s...done" |
819 (if (> (length server) 0) (concat " for " server) "")) | 972 (if (> (length server) 0) (concat " for " server) "")) |
820 t)) | 973 t)) |
821 | 974 |
822 (deffoo nnimap-request-post (&optional server) | 975 (deffoo nnimap-request-post (&optional server) |
823 (let ((success t)) | 976 (let ((success t)) |
824 (dolist (mbx (message-unquote-tokens | 977 (dolist (mbx (message-unquote-tokens |
825 (message-tokenize-header | 978 (message-tokenize-header |
826 (message-fetch-field "Newsgroups") ", ")) success) | 979 (message-fetch-field "Newsgroups") ", ")) success) |
827 (let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method))) | 980 (let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method))) |
828 (or (gnus-active to-newsgroup) | 981 (or (gnus-active to-newsgroup) |
829 (gnus-activate-group to-newsgroup) | 982 (gnus-activate-group to-newsgroup) |
830 (if (gnus-y-or-n-p (format "No such group: %s. Create it? " | 983 (if (gnus-y-or-n-p (format "No such group: %s. Create it? " |
831 to-newsgroup)) | 984 to-newsgroup)) |
838 (unless (nnimap-request-accept-article mbx (nth 1 gnus-command-method)) | 991 (unless (nnimap-request-accept-article mbx (nth 1 gnus-command-method)) |
839 (setq success nil)))))) | 992 (setq success nil)))))) |
840 | 993 |
841 ;; Optional backend functions | 994 ;; Optional backend functions |
842 | 995 |
996 (defun nnimap-string-lessp-numerical (s1 s2) | |
997 "Return t if first arg string is less than second in numerical order." | |
998 (cond ((string= s1 s2) | |
999 nil) | |
1000 ((> (length s1) (length s2)) | |
1001 nil) | |
1002 ((< (length s1) (length s2)) | |
1003 t) | |
1004 ((< (string-to-number (substring s1 0 1)) | |
1005 (string-to-number (substring s2 0 1))) | |
1006 t) | |
1007 ((> (string-to-number (substring s1 0 1)) | |
1008 (string-to-number (substring s2 0 1))) | |
1009 nil) | |
1010 (t | |
1011 (nnimap-string-lessp-numerical (substring s1 1) (substring s2 1))))) | |
1012 | |
843 (deffoo nnimap-retrieve-groups (groups &optional server) | 1013 (deffoo nnimap-retrieve-groups (groups &optional server) |
844 (when (nnimap-possibly-change-server server) | 1014 (when (nnimap-possibly-change-server server) |
845 (gnus-message 5 "nnimap: Checking mailboxes...") | 1015 (gnus-message 5 "nnimap: Checking mailboxes...") |
846 (with-current-buffer nntp-server-buffer | 1016 (with-current-buffer nntp-server-buffer |
847 (erase-buffer) | 1017 (erase-buffer) |
848 (nnimap-before-find-minmax-bugworkaround) | 1018 (nnimap-before-find-minmax-bugworkaround) |
849 (dolist (group groups) | 1019 (let (asyncgroups slowgroups) |
850 (gnus-message 7 "nnimap: Checking mailbox %s" group) | 1020 (if (null nnimap-retrieve-groups-asynchronous) |
851 (or (member "\\NoSelect" | 1021 (setq slowgroups groups) |
852 (imap-mailbox-get 'list-flags group nnimap-server-buffer)) | 1022 (dolist (group groups) |
853 (let ((info (nnimap-find-minmax-uid group 'examine))) | 1023 (gnus-message 9 "nnimap: Quickly checking mailbox %s" group) |
854 (insert (format "\"%s\" %d %d y\n" group | 1024 (add-to-list (if (gnus-gethash-safe |
855 (or (nth 2 info) 0) | 1025 (gnus-group-prefixed-name group server) |
856 (max 1 (or (nth 1 info) 1)))))))) | 1026 nnimap-mailbox-info) |
1027 'asyncgroups | |
1028 'slowgroups) | |
1029 (list group (imap-mailbox-status-asynch | |
1030 group '(uidvalidity uidnext unseen) | |
1031 nnimap-server-buffer)))) | |
1032 (dolist (asyncgroup asyncgroups) | |
1033 (let ((group (nth 0 asyncgroup)) | |
1034 (tag (nth 1 asyncgroup)) | |
1035 new old) | |
1036 (when (imap-ok-p (imap-wait-for-tag tag nnimap-server-buffer)) | |
1037 (if (or (not (string= | |
1038 (nth 0 (gnus-gethash (gnus-group-prefixed-name | |
1039 group server) | |
1040 nnimap-mailbox-info)) | |
1041 (imap-mailbox-get 'uidvalidity group | |
1042 nnimap-server-buffer))) | |
1043 (not (string= | |
1044 (nth 1 (gnus-gethash (gnus-group-prefixed-name | |
1045 group server) | |
1046 nnimap-mailbox-info)) | |
1047 (imap-mailbox-get 'uidnext group | |
1048 nnimap-server-buffer)))) | |
1049 (push (list group) slowgroups) | |
1050 (insert (nth 3 (gnus-gethash (gnus-group-prefixed-name | |
1051 group server) | |
1052 nnimap-mailbox-info)))))))) | |
1053 (dolist (group slowgroups) | |
1054 (if nnimap-retrieve-groups-asynchronous | |
1055 (setq group (car group))) | |
1056 (gnus-message 7 "nnimap: Mailbox %s modified" group) | |
1057 (imap-mailbox-put 'uidnext nil group nnimap-server-buffer) | |
1058 (or (member "\\NoSelect" (imap-mailbox-get 'list-flags group | |
1059 nnimap-server-buffer)) | |
1060 (let* ((info (nnimap-find-minmax-uid group 'examine)) | |
1061 (str (format "\"%s\" %d %d y\n" group | |
1062 (or (nth 2 info) 0) | |
1063 (max 1 (or (nth 1 info) 1))))) | |
1064 (when (> (or (imap-mailbox-get 'recent group | |
1065 nnimap-server-buffer) 0) | |
1066 0) | |
1067 (push (list (cons group 0)) nnmail-split-history)) | |
1068 (insert str) | |
1069 (when nnimap-retrieve-groups-asynchronous | |
1070 (gnus-sethash | |
1071 (gnus-group-prefixed-name group server) | |
1072 (list (or (imap-mailbox-get | |
1073 'uidvalidity group nnimap-server-buffer) | |
1074 (imap-mailbox-status | |
1075 group 'uidvalidity nnimap-server-buffer)) | |
1076 (or (imap-mailbox-get | |
1077 'uidnext group nnimap-server-buffer) | |
1078 (imap-mailbox-status | |
1079 group 'uidnext nnimap-server-buffer)) | |
1080 (or (imap-mailbox-get | |
1081 'unseen group nnimap-server-buffer) | |
1082 (imap-mailbox-status | |
1083 group 'unseen nnimap-server-buffer)) | |
1084 str) | |
1085 nnimap-mailbox-info))))))) | |
857 (gnus-message 5 "nnimap: Checking mailboxes...done") | 1086 (gnus-message 5 "nnimap: Checking mailboxes...done") |
858 'active)) | 1087 'active)) |
859 | 1088 |
860 (deffoo nnimap-request-update-info-internal (group info &optional server) | 1089 (deffoo nnimap-request-update-info-internal (group info &optional server) |
861 (when (nnimap-possibly-change-group group server) | 1090 (when (nnimap-possibly-change-group group server) |
862 (when info;; xxx what does this mean? should we create a info? | 1091 (when info ;; xxx what does this mean? should we create a info? |
863 (with-current-buffer nnimap-server-buffer | 1092 (with-current-buffer nnimap-server-buffer |
864 (gnus-message 5 "nnimap: Updating info for %s..." | 1093 (gnus-message 5 "nnimap: Updating info for %s..." |
865 (gnus-info-group info)) | 1094 (gnus-info-group info)) |
866 | 1095 |
867 (when (nnimap-mark-permanent-p 'read) | 1096 (when (nnimap-mark-permanent-p 'read) |
885 (list (cons (car seen) (car seen))) | 1114 (list (cons (car seen) (car seen))) |
886 seen)) | 1115 seen)) |
887 (gnus-info-set-read info seen))) | 1116 (gnus-info-set-read info seen))) |
888 | 1117 |
889 (mapcar (lambda (pred) | 1118 (mapcar (lambda (pred) |
890 (when (and (nnimap-mark-permanent-p (cdr pred)) | 1119 (when (or (eq (cdr pred) 'recent) |
891 (member (nnimap-mark-to-flag (cdr pred)) | 1120 (and (nnimap-mark-permanent-p (cdr pred)) |
892 (imap-mailbox-get 'flags))) | 1121 (member (nnimap-mark-to-flag (cdr pred)) |
1122 (imap-mailbox-get 'flags)))) | |
893 (gnus-info-set-marks | 1123 (gnus-info-set-marks |
894 info | 1124 info |
895 (nnimap-update-alist-soft | 1125 (gnus-update-alist-soft |
896 (cdr pred) | 1126 (cdr pred) |
897 (gnus-compress-sequence | 1127 (gnus-compress-sequence |
898 (imap-search (nnimap-mark-to-predicate (cdr pred)))) | 1128 (imap-search (nnimap-mark-to-predicate (cdr pred)))) |
899 (gnus-info-marks info)) | 1129 (gnus-info-marks info)) |
900 t))) | 1130 t))) |
901 gnus-article-mark-lists) | 1131 gnus-article-mark-lists) |
902 | 1132 |
903 ;; nnimap mark dormant article as ticked too (for other clients) | 1133 (when nnimap-importantize-dormant |
904 ;; so we remove that mark for gnus since we support dormant | 1134 ;; nnimap mark dormant article as ticked too (for other clients) |
905 (gnus-info-set-marks | 1135 ;; so we remove that mark for gnus since we support dormant |
906 info | 1136 (gnus-info-set-marks |
907 (nnimap-update-alist-soft | 1137 info |
908 'tick | 1138 (gnus-update-alist-soft |
909 (gnus-remove-from-range | 1139 'tick |
910 (cdr-safe (assoc 'tick (gnus-info-marks info))) | 1140 (gnus-remove-from-range |
911 (cdr-safe (assoc 'dormant (gnus-info-marks info)))) | 1141 (cdr-safe (assoc 'tick (gnus-info-marks info))) |
912 (gnus-info-marks info)) | 1142 (cdr-safe (assoc 'dormant (gnus-info-marks info)))) |
913 t) | 1143 (gnus-info-marks info)) |
1144 t)) | |
914 | 1145 |
915 (gnus-message 5 "nnimap: Updating info for %s...done" | 1146 (gnus-message 5 "nnimap: Updating info for %s...done" |
916 (gnus-info-group info)) | 1147 (gnus-info-group info)) |
917 | 1148 |
918 info)))) | 1149 info)))) |
930 (while (setq action (pop actions)) | 1161 (while (setq action (pop actions)) |
931 (let ((range (nth 0 action)) | 1162 (let ((range (nth 0 action)) |
932 (what (nth 1 action)) | 1163 (what (nth 1 action)) |
933 (cmdmarks (nth 2 action)) | 1164 (cmdmarks (nth 2 action)) |
934 marks) | 1165 marks) |
1166 ;; bookmark can't be stored (not list/range | |
1167 (setq cmdmarks (delq 'bookmark cmdmarks)) | |
1168 ;; killed can't be stored (not list/range | |
1169 (setq cmdmarks (delq 'killed cmdmarks)) | |
1170 ;; unsent are for nndraft groups only | |
1171 (setq cmdmarks (delq 'unsent cmdmarks)) | |
935 ;; cache flags are pointless on the server | 1172 ;; cache flags are pointless on the server |
936 (setq cmdmarks (delq 'cache cmdmarks)) | 1173 (setq cmdmarks (delq 'cache cmdmarks)) |
937 ;; flag dormant articles as ticked | 1174 ;; seen flags are local to each gnus |
938 (if (memq 'dormant cmdmarks) | 1175 (setq cmdmarks (delq 'seen cmdmarks)) |
939 (setq cmdmarks (cons 'tick cmdmarks))) | 1176 ;; recent marks can't be set |
1177 (setq cmdmarks (delq 'recent cmdmarks)) | |
1178 (when nnimap-importantize-dormant | |
1179 ;; flag dormant articles as ticked | |
1180 (if (memq 'dormant cmdmarks) | |
1181 (setq cmdmarks (cons 'tick cmdmarks)))) | |
940 ;; remove stuff we are forbidden to store | 1182 ;; remove stuff we are forbidden to store |
941 (mapcar (lambda (mark) | 1183 (mapcar (lambda (mark) |
942 (if (imap-message-flag-permanent-p | 1184 (if (imap-message-flag-permanent-p |
943 (nnimap-mark-to-flag mark)) | 1185 (nnimap-mark-to-flag mark)) |
944 (setq marks (cons mark marks)))) | 1186 (setq marks (cons mark marks)))) |
958 (nnimap-mark-to-flag marks nil t))))))) | 1200 (nnimap-mark-to-flag marks nil t))))))) |
959 (gnus-message 7 "nnimap: Setting marks in %s...done" group)))) | 1201 (gnus-message 7 "nnimap: Setting marks in %s...done" group)))) |
960 nil) | 1202 nil) |
961 | 1203 |
962 (defun nnimap-split-fancy () | 1204 (defun nnimap-split-fancy () |
963 "Like nnmail-split-fancy, but uses nnimap-split-fancy." | 1205 "Like the function `nnmail-split-fancy', but uses `nnimap-split-fancy'." |
964 (let ((nnmail-split-fancy nnimap-split-fancy)) | 1206 (let ((nnmail-split-fancy nnimap-split-fancy)) |
965 (nnmail-split-fancy))) | 1207 (nnmail-split-fancy))) |
966 | 1208 |
967 (defun nnimap-split-to-groups (rules) | 1209 (defun nnimap-split-to-groups (rules) |
968 ;; tries to match all rules in nnimap-split-rule against content of | 1210 ;; tries to match all rules in nnimap-split-rule against content of |
980 (let ((group (car rule)) | 1222 (let ((group (car rule)) |
981 (regexp (cadr rule))) | 1223 (regexp (cadr rule))) |
982 (goto-char (point-min)) | 1224 (goto-char (point-min)) |
983 (when (and (if (stringp regexp) | 1225 (when (and (if (stringp regexp) |
984 (progn | 1226 (progn |
985 (setq regrepp (string-match "\\\\[0-9&]" group)) | 1227 (if (not (stringp group)) |
1228 (setq group (eval group)) | |
1229 (setq regrepp | |
1230 (string-match "\\\\[0-9&]" group))) | |
986 (re-search-forward regexp nil t)) | 1231 (re-search-forward regexp nil t)) |
987 (funcall regexp group)) | 1232 (funcall regexp group)) |
988 ;; Don't enter the article into the same group twice. | 1233 ;; Don't enter the article into the same group twice. |
989 (not (assoc group to-groups))) | 1234 (not (assoc group to-groups))) |
990 (push (if regrepp | 1235 (push (if regrepp |
1002 (setq alist (cdr alist))) | 1247 (setq alist (cdr alist))) |
1003 element)) | 1248 element)) |
1004 | 1249 |
1005 (defun nnimap-split-find-rule (server inbox) | 1250 (defun nnimap-split-find-rule (server inbox) |
1006 (if (and (listp nnimap-split-rule) (listp (car nnimap-split-rule)) | 1251 (if (and (listp nnimap-split-rule) (listp (car nnimap-split-rule)) |
1007 (list (cdar nnimap-split-rule)) (listp (cadar nnimap-split-rule))) | 1252 (list (cdar nnimap-split-rule)) (listp (cadar nnimap-split-rule))) |
1008 ;; extended format | 1253 ;; extended format |
1009 (cadr (nnimap-assoc-match inbox (cdr (nnimap-assoc-match | 1254 (cadr (nnimap-assoc-match inbox (cdr (nnimap-assoc-match |
1010 server nnimap-split-rule)))) | 1255 server nnimap-split-rule)))) |
1011 nnimap-split-rule)) | 1256 nnimap-split-rule)) |
1012 | 1257 |
1019 (when (nnimap-possibly-change-server server) | 1264 (when (nnimap-possibly-change-server server) |
1020 (with-current-buffer nnimap-server-buffer | 1265 (with-current-buffer nnimap-server-buffer |
1021 (let (rule inbox removeorig (inboxes (nnimap-split-find-inbox server))) | 1266 (let (rule inbox removeorig (inboxes (nnimap-split-find-inbox server))) |
1022 ;; iterate over inboxes | 1267 ;; iterate over inboxes |
1023 (while (and (setq inbox (pop inboxes)) | 1268 (while (and (setq inbox (pop inboxes)) |
1024 (nnimap-possibly-change-group inbox));; SELECT | 1269 (nnimap-possibly-change-group inbox)) ;; SELECT |
1025 ;; find split rule for this server / inbox | 1270 ;; find split rule for this server / inbox |
1026 (when (setq rule (nnimap-split-find-rule server inbox)) | 1271 (when (setq rule (nnimap-split-find-rule server inbox)) |
1027 ;; iterate over articles | 1272 ;; iterate over articles |
1028 (dolist (article (imap-search nnimap-split-predicate)) | 1273 (dolist (article (imap-search nnimap-split-predicate)) |
1029 (when (nnimap-request-head article) | 1274 (when (if (if (eq nnimap-split-download-body 'default) |
1275 nnimap-split-download-body-default | |
1276 nnimap-split-download-body) | |
1277 (and (nnimap-request-article article) | |
1278 (with-current-buffer nntp-server-buffer (mail-narrow-to-head))) | |
1279 (nnimap-request-head article)) | |
1030 ;; copy article to right group(s) | 1280 ;; copy article to right group(s) |
1031 (setq removeorig nil) | 1281 (setq removeorig nil) |
1032 (dolist (to-group (nnimap-split-to-groups rule)) | 1282 (dolist (to-group (nnimap-split-to-groups rule)) |
1033 (if (imap-message-copy (number-to-string article) | 1283 (cond ((eq to-group 'junk) |
1034 to-group nil 'nocopyuid) | 1284 (message "IMAP split removed %s:%s:%d" server inbox |
1035 (progn | 1285 article) |
1036 (message "IMAP split moved %s:%s:%d to %s" server inbox | 1286 (setq removeorig t)) |
1037 article to-group) | 1287 ((imap-message-copy (number-to-string article) |
1038 (setq removeorig t) | 1288 to-group nil 'nocopyuid) |
1039 ;; Add the group-art list to the history list. | 1289 (message "IMAP split moved %s:%s:%d to %s" server |
1040 (push (list (cons to-group 0)) nnmail-split-history)) | 1290 inbox article to-group) |
1041 (message "IMAP split failed to move %s:%s:%d to %s" server | 1291 (setq removeorig t) |
1042 inbox article to-group))) | 1292 (when nnmail-cache-accepted-message-ids |
1293 (with-current-buffer nntp-server-buffer | |
1294 (let (msgid) | |
1295 (and (setq msgid | |
1296 (nnmail-fetch-field "message-id")) | |
1297 (nnmail-cache-insert msgid | |
1298 to-group | |
1299 (nnmail-fetch-field "subject")))))) | |
1300 ;; Add the group-art list to the history list. | |
1301 (push (list (cons to-group 0)) nnmail-split-history)) | |
1302 (t | |
1303 (message "IMAP split failed to move %s:%s:%d to %s" | |
1304 server inbox article to-group)))) | |
1305 (if (if (eq nnimap-split-download-body 'default) | |
1306 nnimap-split-download-body-default | |
1307 nnimap-split-download-body) | |
1308 (widen)) | |
1043 ;; remove article if it was successfully copied somewhere | 1309 ;; remove article if it was successfully copied somewhere |
1044 (and removeorig | 1310 (and removeorig |
1045 (imap-message-flags-add (format "%d" article) | 1311 (imap-message-flags-add (format "%d" article) |
1046 "\\Seen \\Deleted"))))) | 1312 "\\Seen \\Deleted"))))) |
1047 (when (imap-mailbox-select inbox);; just in case | 1313 (when (imap-mailbox-select inbox) ;; just in case |
1048 ;; todo: UID EXPUNGE (if available) to remove splitted articles | 1314 ;; todo: UID EXPUNGE (if available) to remove splitted articles |
1049 (imap-mailbox-expunge) | 1315 (imap-mailbox-expunge) |
1050 (imap-mailbox-close))) | 1316 (imap-mailbox-close))) |
1317 (when nnmail-cache-accepted-message-ids | |
1318 (nnmail-cache-close)) | |
1051 t)))) | 1319 t)))) |
1052 | 1320 |
1053 (deffoo nnimap-request-scan (&optional group server) | 1321 (deffoo nnimap-request-scan (&optional group server) |
1054 (nnimap-split-articles group server)) | 1322 (nnimap-split-articles group server)) |
1055 | 1323 |
1060 (if (> (length server) 0) " on " "") server) | 1328 (if (> (length server) 0) " on " "") server) |
1061 (erase-buffer) | 1329 (erase-buffer) |
1062 (nnimap-before-find-minmax-bugworkaround) | 1330 (nnimap-before-find-minmax-bugworkaround) |
1063 (dolist (pattern (nnimap-pattern-to-list-arguments | 1331 (dolist (pattern (nnimap-pattern-to-list-arguments |
1064 nnimap-list-pattern)) | 1332 nnimap-list-pattern)) |
1065 (dolist (mbx (imap-mailbox-lsub "*" (car pattern) nil | 1333 (dolist (mbx (imap-mailbox-lsub (cdr pattern) (car pattern) nil |
1066 nnimap-server-buffer)) | 1334 nnimap-server-buffer)) |
1067 (or (catch 'found | 1335 (or (catch 'found |
1068 (dolist (mailbox (imap-mailbox-get 'list-flags mbx | 1336 (dolist (mailbox (imap-mailbox-get 'list-flags mbx |
1069 nnimap-server-buffer)) | 1337 nnimap-server-buffer)) |
1070 (if (string= (downcase mailbox) "\\noselect") | 1338 (if (string= (downcase mailbox) "\\noselect") |
1071 (throw 'found t))) | 1339 (throw 'found t))) |
1072 nil) | 1340 nil) |
1073 (let ((info (nnimap-find-minmax-uid mbx 'examine))) | 1341 (let ((info (nnimap-find-minmax-uid mbx 'examine))) |
1074 (when info | 1342 (when info |
1075 (insert (format "\"%s\" %d %d y\n" | 1343 (insert (format "\"%s\" %d %d y\n" |
1076 mbx (or (nth 2 info) 0) | 1344 mbx (or (nth 2 info) 0) |
1077 (max 1 (or (nth 1 info) 1))))))))) | 1345 (max 1 (or (nth 1 info) 1))))))))) |
1078 (gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s...done" | 1346 (gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s...done" |
1079 (if (> (length server) 0) " on " "") server)) | 1347 (if (> (length server) 0) " on " "") server)) |
1080 t)) | 1348 t)) |
1081 | 1349 |
1082 (deffoo nnimap-request-create-group (group &optional server args) | 1350 (deffoo nnimap-request-create-group (group &optional server args) |
1083 (when (nnimap-possibly-change-server server) | 1351 (when (nnimap-possibly-change-server server) |
1084 (or (imap-mailbox-status group 'uidvalidity nnimap-server-buffer) | 1352 (or (imap-mailbox-status group 'uidvalidity nnimap-server-buffer) |
1085 (imap-mailbox-create group nnimap-server-buffer)))) | 1353 (imap-mailbox-create group nnimap-server-buffer) |
1354 (nnheader-report 'nnimap "%S" | |
1355 (imap-error-text nnimap-server-buffer))))) | |
1086 | 1356 |
1087 (defun nnimap-time-substract (time1 time2) | 1357 (defun nnimap-time-substract (time1 time2) |
1088 "Return TIME for TIME1 - TIME2." | 1358 "Return TIME for TIME1 - TIME2." |
1089 (let* ((ms (- (car time1) (car time2))) | 1359 (let* ((ms (- (car time1) (car time2))) |
1090 (ls (- (nth 1 time1) (nth 1 time2)))) | 1360 (ls (- (nth 1 time1) (nth 1 time2)))) |
1106 | 1376 |
1107 (defun nnimap-request-expire-articles-progress () | 1377 (defun nnimap-request-expire-articles-progress () |
1108 (gnus-message 5 "nnimap: Marking article %d for deletion..." | 1378 (gnus-message 5 "nnimap: Marking article %d for deletion..." |
1109 imap-current-message)) | 1379 imap-current-message)) |
1110 | 1380 |
1381 (defun nnimap-expiry-target (arts group server) | |
1382 (unless (eq nnmail-expiry-target 'delete) | |
1383 (with-temp-buffer | |
1384 (dolist (art arts) | |
1385 (nnimap-request-article art group server (current-buffer)) | |
1386 ;; hints for optimization in `nnimap-request-accept-article' | |
1387 (let ((nnimap-current-move-article art) | |
1388 (nnimap-current-move-group group) | |
1389 (nnimap-current-move-server server)) | |
1390 (nnmail-expiry-target-group nnmail-expiry-target group)))) | |
1391 ;; It is not clear if `nnmail-expiry-target' somehow cause the | |
1392 ;; current group to be changed or not, so we make sure here. | |
1393 (nnimap-possibly-change-group group server))) | |
1394 | |
1111 ;; Notice that we don't actually delete anything, we just mark them deleted. | 1395 ;; Notice that we don't actually delete anything, we just mark them deleted. |
1112 (deffoo nnimap-request-expire-articles (articles group &optional server force) | 1396 (deffoo nnimap-request-expire-articles (articles group &optional server force) |
1113 (let ((artseq (gnus-compress-sequence articles))) | 1397 (let ((artseq (gnus-compress-sequence articles))) |
1114 (when (and artseq (nnimap-possibly-change-group group server)) | 1398 (when (and artseq (nnimap-possibly-change-group group server)) |
1115 (with-current-buffer nnimap-server-buffer | 1399 (with-current-buffer nnimap-server-buffer |
1116 (if force | 1400 (let ((days (or (and nnmail-expiry-wait-function |
1117 (and (imap-message-flags-add | 1401 (funcall nnmail-expiry-wait-function group)) |
1118 (imap-range-to-message-set artseq) "\\Deleted") | 1402 nnmail-expiry-wait))) |
1119 (setq articles nil)) | 1403 (cond ((or force (eq days 'immediate)) |
1120 (let ((days (or (and nnmail-expiry-wait-function | 1404 (let ((oldarts (imap-search |
1121 (funcall nnmail-expiry-wait-function group)) | 1405 (concat "UID " |
1122 nnmail-expiry-wait))) | 1406 (imap-range-to-message-set artseq))))) |
1123 (cond ((eq days 'immediate) | 1407 (when oldarts |
1124 (and (imap-message-flags-add | 1408 (nnimap-expiry-target oldarts group server) |
1125 (imap-range-to-message-set artseq) "\\Deleted") | 1409 (when (imap-message-flags-add |
1126 (setq articles nil))) | 1410 (imap-range-to-message-set |
1127 ((numberp days) | 1411 (gnus-compress-sequence oldarts)) "\\Deleted") |
1128 (let ((oldarts (imap-search | 1412 (setq articles (gnus-set-difference |
1129 (format "UID %s NOT SINCE %s" | 1413 articles oldarts)))))) |
1130 (imap-range-to-message-set artseq) | 1414 ((numberp days) |
1131 (nnimap-date-days-ago days)))) | 1415 (let ((oldarts (imap-search |
1132 (imap-fetch-data-hook | 1416 (format nnimap-expunge-search-string |
1133 '(nnimap-request-expire-articles-progress))) | 1417 (imap-range-to-message-set artseq) |
1134 (and oldarts | 1418 (nnimap-date-days-ago days)))) |
1135 (imap-message-flags-add | 1419 (imap-fetch-data-hook |
1136 (imap-range-to-message-set | 1420 '(nnimap-request-expire-articles-progress))) |
1137 (gnus-compress-sequence oldarts)) | 1421 (when oldarts |
1138 "\\Deleted") | 1422 (nnimap-expiry-target oldarts group server) |
1139 (setq articles (gnus-set-difference | 1423 (when (imap-message-flags-add |
1140 articles oldarts))))))))))) | 1424 (imap-range-to-message-set |
1425 (gnus-compress-sequence oldarts)) "\\Deleted") | |
1426 (setq articles (gnus-set-difference | |
1427 articles oldarts))))))))))) | |
1141 ;; return articles not deleted | 1428 ;; return articles not deleted |
1142 articles) | 1429 articles) |
1143 | 1430 |
1144 (deffoo nnimap-request-move-article (article group server | 1431 (deffoo nnimap-request-move-article (article group server |
1145 accept-form &optional last) | 1432 accept-form &optional last) |
1156 (buffer-disable-undo (current-buffer)) | 1443 (buffer-disable-undo (current-buffer)) |
1157 (insert-buffer-substring nntp-server-buffer) | 1444 (insert-buffer-substring nntp-server-buffer) |
1158 (setq result (eval accept-form)) | 1445 (setq result (eval accept-form)) |
1159 (kill-buffer buf) | 1446 (kill-buffer buf) |
1160 result) | 1447 result) |
1161 (nnimap-request-expire-articles (list article) group server t)) | 1448 (imap-message-flags-add |
1449 (imap-range-to-message-set (list article)) | |
1450 "\\Deleted" 'silent nnimap-server-buffer)) | |
1162 result)))) | 1451 result)))) |
1163 | 1452 |
1164 (deffoo nnimap-request-accept-article (group &optional server last) | 1453 (deffoo nnimap-request-accept-article (group &optional server last) |
1165 (when (nnimap-possibly-change-server server) | 1454 (when (nnimap-possibly-change-server server) |
1166 (let (uid) | 1455 (let (uid) |
1176 (with-current-buffer (current-buffer) | 1465 (with-current-buffer (current-buffer) |
1177 (goto-char (point-min)) | 1466 (goto-char (point-min)) |
1178 ;; remove any 'From blabla' lines, some IMAP servers | 1467 ;; remove any 'From blabla' lines, some IMAP servers |
1179 ;; reject the entire message otherwise. | 1468 ;; reject the entire message otherwise. |
1180 (when (looking-at "^From[^:]") | 1469 (when (looking-at "^From[^:]") |
1181 (kill-region (point) (progn (forward-line) (point)))) | 1470 (delete-region (point) (progn (forward-line) (point)))) |
1182 ;; turn into rfc822 format (\r\n eol's) | 1471 ;; turn into rfc822 format (\r\n eol's) |
1183 (while (search-forward "\n" nil t) | 1472 (while (search-forward "\n" nil t) |
1184 (replace-match "\r\n"))) | 1473 (replace-match "\r\n")) |
1185 ;; this 'or' is for Cyrus server bug | 1474 (when nnmail-cache-accepted-message-ids |
1186 (or (null (imap-current-mailbox nnimap-server-buffer)) | 1475 (nnmail-cache-insert (nnmail-fetch-field "message-id") |
1187 (imap-mailbox-unselect nnimap-server-buffer)) | 1476 group |
1477 (nnmail-fetch-field "subject")))) | |
1478 (when (and last nnmail-cache-accepted-message-ids) | |
1479 (nnmail-cache-close)) | |
1480 ;; this 'or' is for Cyrus server bug | |
1481 (or (null (imap-current-mailbox nnimap-server-buffer)) | |
1482 (imap-mailbox-unselect nnimap-server-buffer)) | |
1188 (imap-message-append group (current-buffer) nil nil | 1483 (imap-message-append group (current-buffer) nil nil |
1189 nnimap-server-buffer))) | 1484 nnimap-server-buffer))) |
1190 (cons group (nth 1 uid)) | 1485 (cons group (nth 1 uid)) |
1191 (nnheader-report 'nnimap (imap-error-text nnimap-server-buffer)))))) | 1486 (nnheader-report 'nnimap (imap-error-text nnimap-server-buffer)))))) |
1192 | 1487 |
1203 (when (nnimap-possibly-change-server server) | 1498 (when (nnimap-possibly-change-server server) |
1204 (imap-mailbox-rename group new-name nnimap-server-buffer))) | 1499 (imap-mailbox-rename group new-name nnimap-server-buffer))) |
1205 | 1500 |
1206 (defun nnimap-expunge (mailbox server) | 1501 (defun nnimap-expunge (mailbox server) |
1207 (when (nnimap-possibly-change-group mailbox server) | 1502 (when (nnimap-possibly-change-group mailbox server) |
1208 (imap-mailbox-expunge nnimap-server-buffer))) | 1503 (imap-mailbox-expunge nil nnimap-server-buffer))) |
1209 | 1504 |
1210 (defun nnimap-acl-get (mailbox server) | 1505 (defun nnimap-acl-get (mailbox server) |
1211 (when (nnimap-possibly-change-server server) | 1506 (when (nnimap-possibly-change-server server) |
1212 (and (imap-capability 'ACL nnimap-server-buffer) | 1507 (and (imap-capability 'ACL nnimap-server-buffer) |
1213 (imap-mailbox-acl-get mailbox nnimap-server-buffer)))) | 1508 (imap-mailbox-acl-get mailbox nnimap-server-buffer)))) |
1251 | 1546 |
1252 (defconst nnimap-mark-to-predicate-alist | 1547 (defconst nnimap-mark-to-predicate-alist |
1253 (mapcar | 1548 (mapcar |
1254 (lambda (pair) ; cdr is the mark | 1549 (lambda (pair) ; cdr is the mark |
1255 (or (assoc (cdr pair) | 1550 (or (assoc (cdr pair) |
1256 '((read . "SEEN") | 1551 '((read . "SEEN") |
1257 (tick . "FLAGGED") | 1552 (tick . "FLAGGED") |
1258 (draft . "DRAFT") | 1553 (draft . "DRAFT") |
1259 (reply . "ANSWERED"))) | 1554 (recent . "RECENT") |
1260 (cons (cdr pair) | 1555 (reply . "ANSWERED"))) |
1261 (format "KEYWORD gnus-%s" (symbol-name (cdr pair)))))) | 1556 (cons (cdr pair) |
1557 (format "KEYWORD gnus-%s" (symbol-name (cdr pair)))))) | |
1262 (cons '(read . read) gnus-article-mark-lists))) | 1558 (cons '(read . read) gnus-article-mark-lists))) |
1263 | 1559 |
1264 (defun nnimap-mark-to-predicate (pred) | 1560 (defun nnimap-mark-to-predicate (pred) |
1265 "Convert a Gnus mark (a symbol such as read, tick, expire) to a IMAP predicate. | 1561 "Convert a Gnus mark (a symbol such as read, tick, expire) to a IMAP predicate. |
1266 This is a string such as \"SEEN\", \"FLAGGED\", \"KEYWORD gnus-expire\", | 1562 This is a string such as \"SEEN\", \"FLAGGED\", \"KEYWORD gnus-expire\", |
1269 | 1565 |
1270 (defconst nnimap-mark-to-flag-alist | 1566 (defconst nnimap-mark-to-flag-alist |
1271 (mapcar | 1567 (mapcar |
1272 (lambda (pair) | 1568 (lambda (pair) |
1273 (or (assoc (cdr pair) | 1569 (or (assoc (cdr pair) |
1274 '((read . "\\Seen") | 1570 '((read . "\\Seen") |
1275 (tick . "\\Flagged") | 1571 (tick . "\\Flagged") |
1276 (draft . "\\Draft") | 1572 (draft . "\\Draft") |
1277 (reply . "\\Answered"))) | 1573 (recent . "\\Recent") |
1278 (cons (cdr pair) | 1574 (reply . "\\Answered"))) |
1279 (format "gnus-%s" (symbol-name (cdr pair)))))) | 1575 (cons (cdr pair) |
1576 (format "gnus-%s" (symbol-name (cdr pair)))))) | |
1280 (cons '(read . read) gnus-article-mark-lists))) | 1577 (cons '(read . read) gnus-article-mark-lists))) |
1281 | 1578 |
1282 (defun nnimap-mark-to-flag-1 (preds) | 1579 (defun nnimap-mark-to-flag-1 (preds) |
1283 (if (and (not (null preds)) (listp preds)) | 1580 (if (and (not (null preds)) (listp preds)) |
1284 (cons (nnimap-mark-to-flag (car preds)) | 1581 (cons (nnimap-mark-to-flag (car preds)) |
1304 | 1601 |
1305 (defun nnimap-mark-permanent-p (mark &optional group) | 1602 (defun nnimap-mark-permanent-p (mark &optional group) |
1306 "Return t iff MARK can be permanently (between IMAP sessions) saved on articles, in GROUP." | 1603 "Return t iff MARK can be permanently (between IMAP sessions) saved on articles, in GROUP." |
1307 (imap-message-flag-permanent-p (nnimap-mark-to-flag mark))) | 1604 (imap-message-flag-permanent-p (nnimap-mark-to-flag mark))) |
1308 | 1605 |
1309 (defun nnimap-remassoc (key alist) | |
1310 "Delete by side effect any elements of LIST whose car is `equal' to KEY. | |
1311 The modified LIST is returned. If the first member | |
1312 of LIST has a car that is `equal' to KEY, there is no way to remove it | |
1313 by side effect; therefore, write `(setq foo (remassoc key foo))' to be | |
1314 sure of changing the value of `foo'." | |
1315 (when alist | |
1316 (if (equal key (caar alist)) | |
1317 (cdr alist) | |
1318 (setcdr alist (nnimap-remassoc key (cdr alist))) | |
1319 alist))) | |
1320 | |
1321 (defun nnimap-update-alist-soft (key value alist) | |
1322 (if value | |
1323 (cons (cons key value) (nnimap-remassoc key alist)) | |
1324 (nnimap-remassoc key alist))) | |
1325 | |
1326 (when nnimap-debug | 1606 (when nnimap-debug |
1327 (require 'trace) | 1607 (require 'trace) |
1328 (buffer-disable-undo (get-buffer-create nnimap-debug)) | 1608 (buffer-disable-undo (get-buffer-create nnimap-debug-buffer)) |
1329 (mapcar (lambda (f) (trace-function-background f nnimap-debug)) | 1609 (mapcar (lambda (f) (trace-function-background f nnimap-debug-buffer)) |
1330 '( | 1610 '( |
1331 nnimap-possibly-change-server | 1611 nnimap-possibly-change-server |
1332 nnimap-verify-uidvalidity | 1612 nnimap-verify-uidvalidity |
1333 nnimap-find-minmax-uid | 1613 nnimap-find-minmax-uid |
1334 nnimap-before-find-minmax-bugworkaround | 1614 nnimap-before-find-minmax-bugworkaround |
1335 nnimap-possibly-change-group | 1615 nnimap-possibly-change-group |
1336 ;;nnimap-replace-whitespace | 1616 ;;nnimap-replace-whitespace |
1337 nnimap-retrieve-headers-progress | 1617 nnimap-retrieve-headers-progress |
1338 nnimap-retrieve-which-headers | 1618 nnimap-retrieve-which-headers |
1339 nnimap-group-overview-filename | 1619 nnimap-group-overview-filename |
1340 nnimap-retrieve-headers-from-file | 1620 nnimap-retrieve-headers-from-file |
1341 nnimap-retrieve-headers-from-server | 1621 nnimap-retrieve-headers-from-server |
1342 nnimap-retrieve-headers | 1622 nnimap-retrieve-headers |
1343 nnimap-open-connection | 1623 nnimap-open-connection |
1344 nnimap-open-server | 1624 nnimap-open-server |
1345 nnimap-server-opened | 1625 nnimap-server-opened |
1346 nnimap-close-server | 1626 nnimap-close-server |
1347 nnimap-request-close | 1627 nnimap-request-close |
1348 nnimap-status-message | 1628 nnimap-status-message |
1349 ;;nnimap-demule | 1629 ;;nnimap-demule |
1350 nnimap-request-article-part | 1630 nnimap-request-article-part |
1351 nnimap-request-article | 1631 nnimap-request-article |
1352 nnimap-request-head | 1632 nnimap-request-head |
1353 nnimap-request-body | 1633 nnimap-request-body |
1354 nnimap-request-group | 1634 nnimap-request-group |
1355 nnimap-close-group | 1635 nnimap-close-group |
1356 nnimap-pattern-to-list-arguments | 1636 nnimap-pattern-to-list-arguments |
1357 nnimap-request-list | 1637 nnimap-request-list |
1358 nnimap-request-post | 1638 nnimap-request-post |
1359 nnimap-retrieve-groups | 1639 nnimap-retrieve-groups |
1360 nnimap-request-update-info-internal | 1640 nnimap-request-update-info-internal |
1361 nnimap-request-type | 1641 nnimap-request-type |
1362 nnimap-request-set-mark | 1642 nnimap-request-set-mark |
1363 nnimap-split-to-groups | 1643 nnimap-split-to-groups |
1364 nnimap-split-find-rule | 1644 nnimap-split-find-rule |
1365 nnimap-split-find-inbox | 1645 nnimap-split-find-inbox |
1366 nnimap-split-articles | 1646 nnimap-split-articles |
1367 nnimap-request-scan | 1647 nnimap-request-scan |
1368 nnimap-request-newgroups | 1648 nnimap-request-newgroups |
1369 nnimap-request-create-group | 1649 nnimap-request-create-group |
1370 nnimap-time-substract | 1650 nnimap-time-substract |
1371 nnimap-date-days-ago | 1651 nnimap-date-days-ago |
1372 nnimap-request-expire-articles-progress | 1652 nnimap-request-expire-articles-progress |
1373 nnimap-request-expire-articles | 1653 nnimap-request-expire-articles |
1374 nnimap-request-move-article | 1654 nnimap-request-move-article |
1375 nnimap-request-accept-article | 1655 nnimap-request-accept-article |
1376 nnimap-request-delete-group | 1656 nnimap-request-delete-group |
1377 nnimap-request-rename-group | 1657 nnimap-request-rename-group |
1378 gnus-group-nnimap-expunge | 1658 gnus-group-nnimap-expunge |
1379 gnus-group-nnimap-edit-acl | 1659 gnus-group-nnimap-edit-acl |
1380 gnus-group-nnimap-edit-acl-done | 1660 gnus-group-nnimap-edit-acl-done |
1381 nnimap-group-mode-hook | 1661 nnimap-group-mode-hook |
1382 nnimap-mark-to-predicate | 1662 nnimap-mark-to-predicate |
1383 nnimap-mark-to-flag-1 | 1663 nnimap-mark-to-flag-1 |
1384 nnimap-mark-to-flag | 1664 nnimap-mark-to-flag |
1385 nnimap-mark-permanent-p | 1665 nnimap-mark-permanent-p |
1386 nnimap-remassoc | 1666 ))) |
1387 nnimap-update-alist-soft | |
1388 ))) | |
1389 | 1667 |
1390 (provide 'nnimap) | 1668 (provide 'nnimap) |
1391 | 1669 |
1392 ;; arch-tag: 2b001f20-3ff9-4094-a0ad-46807c1ba70b | 1670 ;; arch-tag: 2b001f20-3ff9-4094-a0ad-46807c1ba70b |
1393 ;;; nnimap.el ends here | 1671 ;;; nnimap.el ends here |