/[emacs]/emacs/lisp/gnus/nnimap.el
ViewVC logotype

Diff of /emacs/lisp/gnus/nnimap.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6.2.4 by miles, Tue Jul 6 10:23:36 2004 UTC revision 1.6.2.5 by miles, Thu Sep 16 00:12:16 2004 UTC
# Line 1  Line 1 
1  ;;; nnimap.el --- imap backend for Gnus  ;;; nnimap.el --- imap backend for Gnus
2    ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
3  ;; Copyright (C) 1998,1999,2000,01,02,2004  Free Software Foundation, Inc.  ;;        Free Software Foundation, Inc.
4    
5  ;; Author: Simon Josefsson <jas@pdc.kth.se>  ;; Author: Simon Josefsson <jas@pdc.kth.se>
6  ;;         Jim Radford <radford@robby.caltech.edu>  ;;         Jim Radford <radford@robby.caltech.edu>
# Line 56  Line 56 
56  ;;   o What about Gnus's article editing, can we support it?  NO!  ;;   o What about Gnus's article editing, can we support it?  NO!
57  ;;   o Use \Draft to support the draft group??  ;;   o Use \Draft to support the draft group??
58  ;;   o Duplicate suppression  ;;   o Duplicate suppression
59    ;;   o Rewrite UID SEARCH UID X as UID FETCH X (UID) for those with slow servers
60    
61  ;;; Code:  ;;; Code:
62    
63  (eval-and-compile  (require 'imap)
   (require 'cl)  
   (require 'imap))  
   
64  (require 'nnoo)  (require 'nnoo)
65  (require 'nnmail)  (require 'nnmail)
66  (require 'nnheader)  (require 'nnheader)
# Line 72  Line 70 
70  (require 'gnus-start)  (require 'gnus-start)
71  (require 'gnus-int)  (require 'gnus-int)
72    
73    (eval-when-compile (require 'cl))
74    
75  (nnoo-declare nnimap)  (nnoo-declare nnimap)
76    
77  (defconst nnimap-version "nnimap 0.131")  (defconst nnimap-version "nnimap 1.0")
78    
79    (defgroup nnimap nil
80      "Reading IMAP mail with Gnus."
81      :group 'gnus)
82    
83  (defvoo nnimap-address nil  (defvoo nnimap-address nil
84    "Address of physical IMAP server.  If nil, use the virtual server's name.")    "Address of physical IMAP server.  If nil, use the virtual server's name.")
85    
86  (defvoo nnimap-server-port nil  (defvoo nnimap-server-port nil
87    "Port number on physical IMAP server.    "Port number on physical IMAP server.
88  If nil, defaults to 993 for SSL connections and 143 otherwise.")  If nil, defaults to 993 for TLS/SSL connections and 143 otherwise.")
89    
90  ;; Splitting variables  ;; Splitting variables
91    
92  (defvar nnimap-split-crosspost t  (defcustom nnimap-split-crosspost t
93    "If non-nil, do crossposting if several split methods match the mail.    "If non-nil, do crossposting if several split methods match the mail.
94  If nil, the first match found will be used.")  If nil, the first match found will be used."
95      :group 'nnimap
96      :type 'boolean)
97    
98  (defvar nnimap-split-inbox nil  (defcustom nnimap-split-inbox nil
99    "*Name of mailbox to split mail from.    "Name of mailbox to split mail from.
100    
101  Mail is read from this mailbox and split according to rules in  Mail is read from this mailbox and split according to rules in
102  `nnimap-split-rules'.  `nnimap-split-rule'.
103    
104  This can be a string or a list of strings.")  This can be a string or a list of strings."
105      :group 'nnimap
106      :type '(choice (string)
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  (defvar nnimap-split-rule nil  (defcustom nnimap-split-rule nil
121    "*Mail will be split according to these rules.    "Mail will be split according to these rules.
122    
123  Mail is read from mailbox(es) specified in `nnimap-split-inbox'.  Mail is read from mailbox(es) specified in `nnimap-split-inbox'.
124    
# Line 110  this: Line 130  this:
130  \(setq nnimap-split-rule '((\"INBOX.gnus-imap\"   \"From:.*gnus-imap\")  \(setq nnimap-split-rule '((\"INBOX.gnus-imap\"   \"From:.*gnus-imap\")
131                            (\"INBOX.junk\"        \"Subject:.*buy\")))                            (\"INBOX.junk\"        \"Subject:.*buy\")))
132    
133  As you can see, `nnimap-split-rule' is a list of lists, where the first  As you can see, `nnimap-split-rule' is a list of lists, where the
134  element in each \"rule\" is the name of the IMAP mailbox, and the  first element in each \"rule\" is the name of the IMAP mailbox (or the
135  second is a regexp that nnimap will try to match on the header to find  symbol `junk' if you want to remove the mail), and the second is a
136  a fit.  regexp that nnimap will try to match on the header to find a fit.
137    
138  The second element can also be a function.  In that case, it will be  The second element can also be a function.  In that case, it will be
139  called narrowed to the headers with the first element of the rule as  called narrowed to the headers with the first element of the rule as
# Line 130  the syntax of this variable have been ex Line 150  the syntax of this variable have been ex
150    
151  \(setq nnimap-split-rule  \(setq nnimap-split-rule
152        '((\"my1server\"    (\".*\"    ((\"ding\"    \"ding@gnus.org\")        '((\"my1server\"    (\".*\"    ((\"ding\"    \"ding@gnus.org\")
153                                    (\"junk\"    \"From:.*Simon\")))                                    (\"junk\"    \"From:.*Simon\")))
154          (\"my2server\"    (\"INBOX\" nnimap-split-fancy))          (\"my2server\"    (\"INBOX\" nnimap-split-fancy))
155          (\"my[34]server\" (\".*\"    ((\"private\" \"To:.*Simon\")          (\"my[34]server\" (\".*\"    ((\"private\" \"To:.*Simon\")
156                                    (\"junk\"    my-junk-func)))))                                    (\"junk\"    my-junk-func)))))
157    
158  The virtual server name is in fact a regexp, so that the same rules  The virtual server name is in fact a regexp, so that the same rules
159  may apply to several servers.  In the example, the servers  may apply to several servers.  In the example, the servers
160  \"my3server\" and \"my4server\" both use the same rules.  Similarly,  \"my3server\" and \"my4server\" both use the same rules.  Similarly,
161  the inbox string is also a regexp.  The actual splitting rules are as  the inbox string is also a regexp.  The actual splitting rules are as
162  before, either a function, or a list with group/regexp or  before, either a function, or a list with group/regexp or
163  group/function elements.")  group/function elements."
164      :group 'nnimap
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  (defvar nnimap-split-predicate "UNSEEN UNDELETED"  (defcustom nnimap-split-predicate "UNSEEN UNDELETED"
188    "The predicate used to find articles to split.    "The predicate used to find articles to split.
189  If you use another IMAP client to peek on articles but always would  If you use another IMAP client to peek on articles but always would
190  like nnimap to split them once it's started, you could change this to  like nnimap to split them once it's started, you could change this to
191  \"UNDELETED\". Other available predicates are available in  \"UNDELETED\". Other available predicates are available in
192  RFC2060 section 6.4.4.")  RFC2060 section 6.4.4."
193      :group 'nnimap
194      :type 'string)
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  (defvar nnimap-split-fancy nil  (defvoo nnimap-need-unselect-to-notice-new-mail nil
249    "Like `nnmail-split-fancy', which see.")    "Unselect mailboxes before looking for new mail in them.
250    Some servers seem to need this under some circumstances.")
251    
252  ;; Authorization / Privacy variables  ;; Authorization / Privacy variables
253    
# Line 165  handle. Line 262  handle.
262    
263  Change this if  Change this if
264    
265  1) you want to connect with SSL.  The SSL integration with IMAP is  1) you want to connect with TLS/SSL.  The TLS/SSL integration
266     brain-dead so you'll have to tell it specifically.     with IMAP is suboptimal so you'll have to tell it
267       specifically.
268    
269  2) your server is more capable than your environment -- i.e. your  2) your server is more capable than your environment -- i.e. your
270     server accept Kerberos login's but you haven't installed the     server accept Kerberos login's but you haven't installed the
271     `imtest' program or your machine isn't configured for Kerberos.     `imtest' program or your machine isn't configured for Kerberos.
272    
273  Possible choices: kerberos4, ssl, network")  Possible choices: gssapi, kerberos4, starttls, tls, ssl, network, shell.
274    See also `imap-streams' and `imap-stream-alist'.")
275    
276  (defvoo nnimap-authenticator nil  (defvoo nnimap-authenticator nil
277    "How nnimap authenticate itself to the server.    "How nnimap authenticate itself to the server.
# Line 186  connect to a server that accept Kerberos Line 285  connect to a server that accept Kerberos
285  installed the `imtest' program or your machine isn't configured for  installed the `imtest' program or your machine isn't configured for
286  Kerberos.  Kerberos.
287    
288  Possible choices: kerberos4, cram-md5, login, anonymous.")  Possible choices: gssapi, kerberos4, digest-md5, cram-md5, login, anonymous.
289    See also `imap-authenticators' and `imap-authenticator-alist'")
290    
291  (defvoo nnimap-directory (nnheader-concat gnus-directory "overview/")  (defvoo nnimap-directory (nnheader-concat gnus-directory "overview/")
292    "Directory to keep NOV cache files for nnimap groups.    "Directory to keep NOV cache files for nnimap groups.
# Line 203  typical complete file name would be Line 303  typical complete file name would be
303  (defvoo nnimap-nov-file-name-suffix ".novcache"  (defvoo nnimap-nov-file-name-suffix ".novcache"
304    "Suffix for NOV cache base filename.")    "Suffix for NOV cache base filename.")
305    
306  (defvoo nnimap-nov-is-evil nil  (defvoo nnimap-nov-is-evil gnus-agent
307    "If non-nil, nnimap will never generate or use a local nov database for this backend.    "If non-nil, never generate or use a local nov database for this backend.
308  Using nov databases will speed up header fetching considerably.  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.
312  Unlike other backends, you do not need to take special care if you  Unlike other backends, you do not need to take special care if you
313  flip this variable.")  flip this variable.")
314    
# Line 238  There are two wildcards * and %. * match Line 341  There are two wildcards * and %. * match
341  everything in the current hierarchy.")  everything in the current hierarchy.")
342    
343  (defvoo nnimap-news-groups nil  (defvoo nnimap-news-groups nil
344    "IMAP support a news-like mode, also known as bulletin board mode, where replies is sent via IMAP instead of SMTP.    "IMAP support a news-like mode, also known as bulletin board mode,
345    where replies is sent via IMAP instead of SMTP.
346    
347  This variable should contain a regexp matching groups where you wish  This variable should contain a regexp matching groups where you wish
348  replies to be stored to the mailbox directly.  replies to be stored to the mailbox directly.
# Line 253  news-like mailboxes.  If you wish to hav Line 357  news-like mailboxes.  If you wish to hav
357  similar which you wouldn't want to set up a mailing list for, you can  similar which you wouldn't want to set up a mailing list for, you can
358  use this to make replies go directly to the group.")  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.")
375    
376  (defvoo nnimap-server-address nil  (defvoo nnimap-server-address nil
377    "Obsolete.  Use `nnimap-address'.")    "Obsolete.  Use `nnimap-address'.")
378    
# Line 284  use this to make replies go directly to Line 404  use this to make replies go directly to
404  If this is 'imap-mailbox-lsub, then use a server-side subscription list to  If this is 'imap-mailbox-lsub, then use a server-side subscription list to
405  restrict visible folders.")  restrict visible folders.")
406    
407    (defcustom nnimap-debug nil
408      "If non-nil, random debug spews are placed in *nnimap-debug* buffer."
409      :group 'nnimap
410      :type 'boolean)
411    
412  ;; Internal variables:  ;; Internal variables:
413    
414  (defvar nnimap-debug nil  (defvar nnimap-debug-buffer "*nnimap-debug*")
415    "Name of buffer to record debugging info.  (defvar nnimap-mailbox-info (gnus-make-hashtable 997))
 For example: (setq nnimap-debug \"*nnimap-debug*\")")  
416  (defvar nnimap-current-move-server nil)  (defvar nnimap-current-move-server nil)
417  (defvar nnimap-current-move-group nil)  (defvar nnimap-current-move-group nil)
418  (defvar nnimap-current-move-article nil)  (defvar nnimap-current-move-article nil)
# Line 296  For example: (setq nnimap-debug \"*nnima Line 420  For example: (setq nnimap-debug \"*nnima
420  (defvar nnimap-progress-chars '(?| ?/ ?- ?\\))  (defvar nnimap-progress-chars '(?| ?/ ?- ?\\))
421  (defvar nnimap-progress-how-often 20)  (defvar nnimap-progress-how-often 20)
422  (defvar nnimap-counter)  (defvar nnimap-counter)
 (defvar nnimap-callback-callback-function nil  
   "Gnus callback the nnimap asynchronous callback should call.")  
 (defvar nnimap-callback-buffer nil  
   "Which buffer the asynchronous article prefetch callback should work in.")  
423  (defvar nnimap-server-buffer-alist nil) ;; Map server name to buffers.  (defvar nnimap-server-buffer-alist nil) ;; Map server name to buffers.
424  (defvar nnimap-current-server nil)      ;; Current server  (defvar nnimap-current-server nil) ;; Current server
425  (defvar nnimap-server-buffer nil)       ;; Current servers' buffer  (defvar nnimap-server-buffer nil) ;; Current servers' buffer
426    
427    
428    
# Line 328  If SERVER is nil, uses the current serve Line 448  If SERVER is nil, uses the current serve
448           (new-uidvalidity (imap-mailbox-get 'uidvalidity))           (new-uidvalidity (imap-mailbox-get 'uidvalidity))
449           (old-uidvalidity (gnus-group-get-parameter gnusgroup 'uidvalidity))           (old-uidvalidity (gnus-group-get-parameter gnusgroup 'uidvalidity))
450           (dir (file-name-as-directory (expand-file-name nnimap-directory)))           (dir (file-name-as-directory (expand-file-name nnimap-directory)))
451           (nameuid (nnheader-translate-file-chars           (nameuid (nnheader-translate-file-chars
452                     (concat nnimap-nov-file-name                     (concat nnimap-nov-file-name
453                             (if (equal server "")                             (if (equal server "")
454                                 "unnamed"                                 "unnamed"
455                               server) "." group "." old-uidvalidity                               server) "." group "." old-uidvalidity
456                               nnimap-nov-file-name-suffix) t))                             nnimap-nov-file-name-suffix) t))
457           (file (if (or nnmail-use-long-file-names           (file (if (or nnmail-use-long-file-names
458                         (file-exists-p (expand-file-name nameuid dir)))                         (file-exists-p (expand-file-name nameuid dir)))
459                     (expand-file-name nameuid dir)                     (expand-file-name nameuid dir)
460                   (expand-file-name                   (expand-file-name
# Line 354  If SERVER is nil, uses the current serve Line 474  If SERVER is nil, uses the current serve
474  (defun nnimap-before-find-minmax-bugworkaround ()  (defun nnimap-before-find-minmax-bugworkaround ()
475    "Function called before iterating through mailboxes with    "Function called before iterating through mailboxes with
476  `nnimap-find-minmax-uid'."  `nnimap-find-minmax-uid'."
477    ;; XXX this is for UoW imapd problem, it doesn't notice new mail in    (when nnimap-need-unselect-to-notice-new-mail
478    ;; currently selected mailbox without a re-select/examine.      ;; XXX this is for UoW imapd problem, it doesn't notice new mail in
479    (or (null (imap-current-mailbox nnimap-server-buffer))      ;; currently selected mailbox without a re-select/examine.
480        (imap-mailbox-unselect nnimap-server-buffer)))      (or (null (imap-current-mailbox nnimap-server-buffer))
481            (imap-mailbox-unselect nnimap-server-buffer))))
482    
483  (defun nnimap-find-minmax-uid (group &optional examine)  (defun nnimap-find-minmax-uid (group &optional examine)
484    "Find lowest and highest active article number in GROUP.    "Find lowest and highest active article number in GROUP.
485  If EXAMINE is non-nil the group is selected read-only."  If EXAMINE is non-nil the group is selected read-only."
486    (with-current-buffer nnimap-server-buffer    (with-current-buffer nnimap-server-buffer
487      (when (imap-mailbox-select group examine)      (when (or (string= group (imap-current-mailbox))
488                  (imap-mailbox-select group examine))
489        (let (minuid maxuid)        (let (minuid maxuid)
490          (when (> (imap-mailbox-get 'exists) 0)          (when (> (imap-mailbox-get 'exists) 0)
491            (imap-fetch "1,*" "UID" nil 'nouidfetch)            (imap-fetch "1,*" "UID" nil 'nouidfetch)
# Line 383  If EXAMINE is non-nil the group is selec Line 505  If EXAMINE is non-nil the group is selec
505              (if (or (nnimap-verify-uidvalidity              (if (or (nnimap-verify-uidvalidity
506                       group (or server nnimap-current-server))                       group (or server nnimap-current-server))
507                      (zerop (imap-mailbox-get 'exists group))                      (zerop (imap-mailbox-get 'exists group))
508                        t ;; for OGnus to see if ignoring uidvalidity
509                        ;; changes has any bad effects.
510                      (yes-or-no-p                      (yes-or-no-p
511                       (format                       (format
512                        "nnimap: Group %s is not uidvalid.  Continue? " group)))                        "nnimap: Group %s is not uidvalid.  Continue? " group)))
# Line 428  If EXAMINE is non-nil the group is selec Line 552  If EXAMINE is non-nil the group is selec
552         (with-temp-buffer         (with-temp-buffer
553           (buffer-disable-undo)           (buffer-disable-undo)
554           (insert headers)           (insert headers)
555           (nnheader-ms-strip-cr)           (let ((head (nnheader-parse-naked-head)))
          (nnheader-fold-continuation-lines)  
          (subst-char-in-region (point-min) (point-max) ?\t ? )  
          (let ((head (nnheader-parse-head 'naked)))  
556             (mail-header-set-number head uid)             (mail-header-set-number head uid)
557             (mail-header-set-chars head chars)             (mail-header-set-chars head chars)
558             (mail-header-set-lines head lines)             (mail-header-set-lines head lines)
# Line 456  If EXAMINE is non-nil the group is selec Line 577  If EXAMINE is non-nil the group is selec
577                             articles)))))                             articles)))))
578        (mapcar (lambda (msgid)        (mapcar (lambda (msgid)
579                  (imap-search                  (imap-search
580                   (format "HEADER Message-Id %s" msgid)))                   (format "HEADER Message-Id \"%s\"" msgid)))
581                articles))))                articles))))
582    
583  (defun nnimap-group-overview-filename (group server)  (defun nnimap-group-overview-filename (group server)
584    "Make file name for GROUP on SERVER."    "Make file name for GROUP on SERVER."
585    (let* ((dir (file-name-as-directory (expand-file-name nnimap-directory)))    (let* ((dir (file-name-as-directory (expand-file-name nnimap-directory)))
586           (uidvalidity (gnus-group-get-parameter           (uidvalidity (gnus-group-get-parameter
587                         (gnus-group-prefixed-name                         (gnus-group-prefixed-name
588                          group (gnus-server-to-method                          group (gnus-server-to-method
589                                 (format "nnimap:%s" server)))                                 (format "nnimap:%s" server)))
590                         'uidvalidity))                         'uidvalidity))
591           (name (nnheader-translate-file-chars           (name (nnheader-translate-file-chars
592                  (concat nnimap-nov-file-name                  (concat nnimap-nov-file-name
593                          (if (equal server "")                          (if (equal server "")
594                              "unnamed"                              "unnamed"
595                            server) "." group nnimap-nov-file-name-suffix) t))                            server) "." group nnimap-nov-file-name-suffix) t))
596           (nameuid (nnheader-translate-file-chars           (nameuid (nnheader-translate-file-chars
597                     (concat nnimap-nov-file-name                     (concat nnimap-nov-file-name
598                             (if (equal server "")                             (if (equal server "")
599                                 "unnamed"                                 "unnamed"
600                               server) "." group "." uidvalidity                               server) "." group "." uidvalidity
601                               nnimap-nov-file-name-suffix) t))                             nnimap-nov-file-name-suffix) t))
602           (oldfile (if (or nnmail-use-long-file-names           (oldfile (if (or nnmail-use-long-file-names
603                            (file-exists-p (expand-file-name name dir)))                            (file-exists-p (expand-file-name name dir)))
604                        (expand-file-name name dir)                        (expand-file-name name dir)
605                      (expand-file-name                      (expand-file-name
606                       (mm-encode-coding-string                       (mm-encode-coding-string
607                        (nnheader-replace-chars-in-string name ?. ?/)                        (nnheader-replace-chars-in-string name ?. ?/)
608                        nnmail-pathname-coding-system)                        nnmail-pathname-coding-system)
609                       dir)))                       dir)))
610           (newfile (if (or nnmail-use-long-file-names           (newfile (if (or nnmail-use-long-file-names
611                            (file-exists-p (expand-file-name nameuid dir)))                            (file-exists-p (expand-file-name nameuid dir)))
612                        (expand-file-name nameuid dir)                        (expand-file-name nameuid dir)
613                      (expand-file-name                      (expand-file-name
614                       (mm-encode-coding-string                       (mm-encode-coding-string
615                        (nnheader-replace-chars-in-string nameuid ?. ?/)                        (nnheader-replace-chars-in-string nameuid ?. ?/)
616                        nnmail-pathname-coding-system)                        nnmail-pathname-coding-system)
617                       dir))))                       dir))))
618      (when (and (file-exists-p oldfile) (not (file-exists-p newfile)))      (when (and (file-exists-p oldfile) (not (file-exists-p newfile)))
619        (message "nnimap: Upgrading novcache filename...")        (message "nnimap: Upgrading novcache filename...")
620        (sit-for 1)        (sit-for 1)
# Line 540  If EXAMINE is non-nil the group is selec Line 661  If EXAMINE is non-nil the group is selec
661             (> nnimap-length nnmail-large-newsgroup)             (> nnimap-length nnmail-large-newsgroup)
662             (nnheader-message 6 "nnimap: Retrieving headers...done")))))             (nnheader-message 6 "nnimap: Retrieving headers...done")))))
663    
664  (defun nnimap-use-nov-p (group server)  (defun nnimap-dont-use-nov-p (group server)
665    (or gnus-nov-is-evil nnimap-nov-is-evil    (or gnus-nov-is-evil nnimap-nov-is-evil
666        (unless (and (gnus-make-directory        (unless (and (gnus-make-directory
667                      (file-name-directory                      (file-name-directory
# Line 554  If EXAMINE is non-nil the group is selec Line 675  If EXAMINE is non-nil the group is selec
675    (when (nnimap-possibly-change-group group server)    (when (nnimap-possibly-change-group group server)
676      (with-current-buffer nntp-server-buffer      (with-current-buffer nntp-server-buffer
677        (erase-buffer)        (erase-buffer)
678        (if (nnimap-use-nov-p group server)        (if (nnimap-dont-use-nov-p group server)
679            (nnimap-retrieve-headers-from-server            (nnimap-retrieve-headers-from-server
680             (gnus-compress-sequence articles) group server)             (gnus-compress-sequence articles) group server)
681          (let (uids cached low high)          (let (uids cached low high)
# Line 577  If EXAMINE is non-nil the group is selec Line 698  If EXAMINE is non-nil the group is selec
698                      ;; remove nov's for articles which has expired on server                      ;; remove nov's for articles which has expired on server
699                      (goto-char (point-min))                      (goto-char (point-min))
700                      (dolist (uid (gnus-set-difference articles uids))                      (dolist (uid (gnus-set-difference articles uids))
701                        (when (re-search-forward (format "^%d\t" uid) nil t)                        (when (re-search-forward (format "^%d\t" uid) nil t)
702                          (gnus-delete-line)))))                          (gnus-delete-line)))))
703                ;; nothing cached, fetch whole range from server                ;; nothing cached, fetch whole range from server
704                (nnimap-retrieve-headers-from-server                (nnimap-retrieve-headers-from-server
705                 (cons low high) group server))                 (cons low high) group server))
# Line 601  If EXAMINE is non-nil the group is selec Line 722  If EXAMINE is non-nil the group is selec
722             (port (if nnimap-server-port             (port (if nnimap-server-port
723                       (int-to-string nnimap-server-port)                       (int-to-string nnimap-server-port)
724                     "imap"))                     "imap"))
725             (alist (gnus-netrc-machine list (or nnimap-server-address             (alist (or (gnus-netrc-machine list server port "imap")
726                                                 nnimap-address server)                        (gnus-netrc-machine list
727                                        port "imap"))                                            (or nnimap-server-address
728                                                  nnimap-address)
729                                              port "imap")))
730             (user (gnus-netrc-get alist "login"))             (user (gnus-netrc-get alist "login"))
731             (passwd (gnus-netrc-get alist "password")))             (passwd (gnus-netrc-get alist "password")))
732        (if (imap-authenticate user passwd nnimap-server-buffer)        (if (imap-authenticate user passwd nnimap-server-buffer)
# Line 629  If EXAMINE is non-nil the group is selec Line 752  If EXAMINE is non-nil the group is selec
752                        (cadr (assq 'nnimap-server-address defs))) defs)                        (cadr (assq 'nnimap-server-address defs))) defs)
753          (push (list 'nnimap-address server) defs)))          (push (list 'nnimap-address server) defs)))
754      (nnoo-change-server 'nnimap server defs)      (nnoo-change-server 'nnimap server defs)
755        (or nnimap-server-buffer
756            (setq nnimap-server-buffer (cadr (assq 'nnimap-server-buffer defs))))
757      (with-current-buffer (get-buffer-create nnimap-server-buffer)      (with-current-buffer (get-buffer-create nnimap-server-buffer)
758        (nnoo-change-server 'nnimap server defs))        (nnoo-change-server 'nnimap server defs))
759      (or (and nnimap-server-buffer      (or (and nnimap-server-buffer
760               (imap-opened nnimap-server-buffer))               (imap-opened nnimap-server-buffer)
761                 (if (with-current-buffer nnimap-server-buffer
762                       (memq imap-state '(auth select examine)))
763                     t
764                   (imap-close nnimap-server-buffer)
765                   (nnimap-open-connection server)))
766          (nnimap-open-connection server))))          (nnimap-open-connection server))))
767    
768  (deffoo nnimap-server-opened (&optional server)  (deffoo nnimap-server-opened (&optional server)
# Line 683  function is generally only called when G Line 813  function is generally only called when G
813               'identity)               'identity)
814             (or string "")))             (or string "")))
815    
816  (defun nnimap-callback ()  (defun nnimap-make-callback (article gnus-callback buffer)
817    (remove-hook 'imap-fetch-data-hook 'nnimap-callback)    "Return a callback function."
818    (with-current-buffer nnimap-callback-buffer    `(lambda ()
819      (insert       (nnimap-callback ,article ,gnus-callback ,buffer)))
820       (with-current-buffer nnimap-server-buffer  
821         (nnimap-demule  (defun nnimap-callback (article gnus-callback buffer)
822          (if (imap-capability 'IMAP4rev1)    (when (eq article (imap-current-message))
823              ;; xxx don't just use car? alist doesn't contain      (remove-hook 'imap-fetch-data-hook
824              ;; anything else now, but it might...                   (nnimap-make-callback article gnus-callback buffer))
825              (nth 2 (car (imap-message-get (imap-current-message) 'BODYDETAIL)))      (with-current-buffer buffer
826            (imap-message-get (imap-current-message) 'RFC822)))))        (insert
827      (nnheader-ms-strip-cr)         (with-current-buffer nnimap-server-buffer
828      (funcall nnimap-callback-callback-function t)))           (nnimap-demule
829              (if (imap-capability 'IMAP4rev1)
830                  ;; xxx don't just use car? alist doesn't contain
831                  ;; anything else now, but it might...
832                  (nth 2 (car (imap-message-get article 'BODYDETAIL)))
833                (imap-message-get article 'RFC822)))))
834          (nnheader-ms-strip-cr)
835          (funcall gnus-callback t))))
836    
837  (defun nnimap-request-article-part (article part prop &optional  (defun nnimap-request-article-part (article part prop &optional
838                                              group server to-buffer detail)                                              group server to-buffer detail)
839    (when (nnimap-possibly-change-group group server)    (when (nnimap-possibly-change-group group server)
840      (let ((article (if (stringp article)      (let ((article (if (stringp article)
841                         (car-safe (imap-search                         (car-safe (imap-search
842                                    (format "HEADER Message-Id %s" article)                                    (format "HEADER Message-Id \"%s\"" article)
843                                    nnimap-server-buffer))                                    nnimap-server-buffer))
844                       article)))                       article)))
845        (when article        (when article
846          (gnus-message 10 "nnimap: Fetching (part of) article %d..." article)          (gnus-message 10 "nnimap: Fetching (part of) article %d from %s..."
847                          article (or group imap-current-mailbox
848                                      gnus-newsgroup-name))
849          (if (not nnheader-callback-function)          (if (not nnheader-callback-function)
850              (with-current-buffer (or to-buffer nntp-server-buffer)              (with-current-buffer (or to-buffer nntp-server-buffer)
851                (erase-buffer)                (erase-buffer)
852                (let ((data (imap-fetch article part prop nil                (let ((data (imap-fetch article part prop nil
853                                        nnimap-server-buffer)))                                        nnimap-server-buffer)))
854                  (insert (nnimap-demule (if detail                  (insert (nnimap-demule (if detail
855                                             (nth 2 (car data))                                             (nth 2 (car data))
856                                           data))))                                           data))))
857                (nnheader-ms-strip-cr)                (nnheader-ms-strip-cr)
858                (gnus-message 10 "nnimap: Fetching (part of) article %d...done"                (gnus-message
859                              article)                 10 "nnimap: Fetching (part of) article %d from %s...done"
860                   article (or group imap-current-mailbox gnus-newsgroup-name))
861                (if (bobp)                (if (bobp)
862                    (nnheader-report 'nnimap "No such article: %s"                    (nnheader-report 'nnimap "No such article %d in %s: %s"
863                                       article (or group imap-current-mailbox
864                                                   gnus-newsgroup-name)
865                                     (imap-error-text nnimap-server-buffer))                                     (imap-error-text nnimap-server-buffer))
866                  (cons group article)))                  (cons group article)))
867            (add-hook 'imap-fetch-data-hook 'nnimap-callback)            (add-hook 'imap-fetch-data-hook
868            (setq nnimap-callback-callback-function nnheader-callback-function                      (nnimap-make-callback article
869                  nnimap-callback-buffer nntp-server-buffer)                                            nnheader-callback-function
870                                              nntp-server-buffer))
871            (imap-fetch-asynch article part nil nnimap-server-buffer)            (imap-fetch-asynch article part nil nnimap-server-buffer)
872            (cons group article))))))            (cons group article))))))
873    
# Line 772  function is generally only called when G Line 915  function is generally only called when G
915               (nnheader-report 'nnimap "Group %s selected" group)               (nnheader-report 'nnimap "Group %s selected" group)
916               t)))))               t)))))
917    
918    (defun nnimap-update-unseen (group &optional server)
919      "Update the unseen count in `nnimap-mailbox-info'."
920      (gnus-sethash
921       (gnus-group-prefixed-name group server)
922       (let ((old (gnus-gethash-safe (gnus-group-prefixed-name group server)
923                                     nnimap-mailbox-info)))
924         (list (nth 0 old) (nth 1 old)
925               (imap-mailbox-status group 'unseen nnimap-server-buffer)
926               (nth 3 old)))
927       nnimap-mailbox-info))
928    
929  (defun nnimap-close-group (group &optional server)  (defun nnimap-close-group (group &optional server)
930    (with-current-buffer nnimap-server-buffer    (with-current-buffer nnimap-server-buffer
931      (when (and (imap-opened)      (when (and (imap-opened)
932                 (nnimap-possibly-change-group group server))                 (nnimap-possibly-change-group group server))
933          (nnimap-update-unseen group server)
934        (case nnimap-expunge-on-close        (case nnimap-expunge-on-close
935          ('always (imap-mailbox-expunge)          (always (progn
936                   (imap-mailbox-close))                    (imap-mailbox-expunge nnimap-close-asynchronous)
937          ('ask (if (and (imap-search "DELETED")                    (unless nnimap-dont-close
938                         (gnus-y-or-n-p (format                      (imap-mailbox-close nnimap-close-asynchronous))))
939                                         "Expunge articles in group `%s'? "          (ask (if (and (imap-search "DELETED")
940                                         imap-current-mailbox)))                        (gnus-y-or-n-p (format "Expunge articles in group `%s'? "
941                    (progn (imap-mailbox-expunge)                                               imap-current-mailbox)))
942                           (imap-mailbox-close))                   (progn
943                  (imap-mailbox-unselect)))                     (imap-mailbox-expunge nnimap-close-asynchronous)
944                       (unless nnimap-dont-close
945                         (imap-mailbox-close nnimap-close-asynchronous)))
946                   (imap-mailbox-unselect)))
947          (t (imap-mailbox-unselect)))          (t (imap-mailbox-unselect)))
948        (not imap-current-mailbox))))        (not imap-current-mailbox))))
949    
# Line 812  function is generally only called when G Line 970  function is generally only called when G
970                (let ((info (nnimap-find-minmax-uid mbx 'examine)))                (let ((info (nnimap-find-minmax-uid mbx 'examine)))
971                  (when info                  (when info
972                    (with-current-buffer nntp-server-buffer                    (with-current-buffer nntp-server-buffer
973                     (insert (format "\"%s\" %d %d y\n"                      (insert (format "\"%s\" %d %d y\n"
974                                     mbx (or (nth 2 info) 0)                                      mbx (or (nth 2 info) 0)
975                                     (max 1 (or (nth 1 info) 1)))))))))))                                      (max 1 (or (nth 1 info) 1)))))))))))
976      (gnus-message 5 "nnimap: Generating active list%s...done"      (gnus-message 5 "nnimap: Generating active list%s...done"
977                    (if (> (length server) 0) (concat " for " server) ""))                    (if (> (length server) 0) (concat " for " server) ""))
978      t))      t))
# Line 822  function is generally only called when G Line 980  function is generally only called when G
980  (deffoo nnimap-request-post (&optional server)  (deffoo nnimap-request-post (&optional server)
981    (let ((success t))    (let ((success t))
982      (dolist (mbx (message-unquote-tokens      (dolist (mbx (message-unquote-tokens
983                    (message-tokenize-header                    (message-tokenize-header
984                     (message-fetch-field "Newsgroups") ", ")) success)                     (message-fetch-field "Newsgroups") ", ")) success)
985        (let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method)))        (let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method)))
986          (or (gnus-active to-newsgroup)          (or (gnus-active to-newsgroup)
987              (gnus-activate-group to-newsgroup)              (gnus-activate-group to-newsgroup)
# Line 840  function is generally only called when G Line 998  function is generally only called when G
998    
999  ;; Optional backend functions  ;; Optional backend functions
1000    
1001    (defun nnimap-string-lessp-numerical (s1 s2)
1002      "Return t if first arg string is less than second in numerical order."
1003      (cond ((string= s1 s2)
1004             nil)
1005            ((> (length s1) (length s2))
1006             nil)
1007            ((< (length s1) (length s2))
1008             t)
1009            ((< (string-to-number (substring s1 0 1))
1010                (string-to-number (substring s2 0 1)))
1011             t)
1012            ((> (string-to-number (substring s1 0 1))
1013                (string-to-number (substring s2 0 1)))
1014             nil)
1015            (t
1016             (nnimap-string-lessp-numerical (substring s1 1) (substring s2 1)))))
1017    
1018  (deffoo nnimap-retrieve-groups (groups &optional server)  (deffoo nnimap-retrieve-groups (groups &optional server)
1019    (when (nnimap-possibly-change-server server)    (when (nnimap-possibly-change-server server)
1020      (gnus-message 5 "nnimap: Checking mailboxes...")      (gnus-message 5 "nnimap: Checking mailboxes...")
1021      (with-current-buffer nntp-server-buffer      (with-current-buffer nntp-server-buffer
1022        (erase-buffer)        (erase-buffer)
1023        (nnimap-before-find-minmax-bugworkaround)        (nnimap-before-find-minmax-bugworkaround)
1024        (dolist (group groups)        (let (asyncgroups slowgroups)
1025          (gnus-message 7 "nnimap: Checking mailbox %s" group)          (if (null nnimap-retrieve-groups-asynchronous)
1026          (or (member "\\NoSelect"              (setq slowgroups groups)
1027                      (imap-mailbox-get 'list-flags group nnimap-server-buffer))            (dolist (group groups)
1028              (let ((info (nnimap-find-minmax-uid group 'examine)))              (gnus-message 9 "nnimap: Quickly checking mailbox %s" group)
1029                (insert (format "\"%s\" %d %d y\n" group              (add-to-list (if (gnus-gethash-safe
1030                                (or (nth 2 info) 0)                                (gnus-group-prefixed-name group server)
1031                                (max 1 (or (nth 1 info) 1))))))))                                nnimap-mailbox-info)
1032                                 'asyncgroups
1033                               'slowgroups)
1034                             (list group (imap-mailbox-status-asynch
1035                                          group '(uidvalidity uidnext unseen)
1036                                          nnimap-server-buffer))))
1037              (dolist (asyncgroup asyncgroups)
1038                (let ((group (nth 0 asyncgroup))
1039                      (tag   (nth 1 asyncgroup))
1040                      new old)
1041                  (when (imap-ok-p (imap-wait-for-tag tag nnimap-server-buffer))
1042                    (if (or (not (string=
1043                                  (nth 0 (gnus-gethash (gnus-group-prefixed-name
1044                                                        group server)
1045                                                       nnimap-mailbox-info))
1046                                  (imap-mailbox-get 'uidvalidity group
1047                                                    nnimap-server-buffer)))
1048                            (not (string=
1049                                  (nth 1 (gnus-gethash (gnus-group-prefixed-name
1050                                                        group server)
1051                                                       nnimap-mailbox-info))
1052                                  (imap-mailbox-get 'uidnext group
1053                                                    nnimap-server-buffer))))
1054                        (push (list group) slowgroups)
1055                      (insert (nth 3 (gnus-gethash (gnus-group-prefixed-name
1056                                                    group server)
1057                                                   nnimap-mailbox-info))))))))
1058            (dolist (group slowgroups)
1059              (if nnimap-retrieve-groups-asynchronous
1060                  (setq group (car group)))
1061              (gnus-message 7 "nnimap: Mailbox %s modified" group)
1062              (imap-mailbox-put 'uidnext nil group nnimap-server-buffer)
1063              (or (member "\\NoSelect" (imap-mailbox-get 'list-flags group
1064                                                         nnimap-server-buffer))
1065                  (let* ((info (nnimap-find-minmax-uid group 'examine))
1066                         (str (format "\"%s\" %d %d y\n" group
1067                                      (or (nth 2 info) 0)
1068                                      (max 1 (or (nth 1 info) 1)))))
1069                    (when (> (or (imap-mailbox-get 'recent group
1070                                                   nnimap-server-buffer) 0)
1071                             0)
1072                      (push (list (cons group 0)) nnmail-split-history))
1073                    (insert str)
1074                    (when nnimap-retrieve-groups-asynchronous
1075                      (gnus-sethash
1076                       (gnus-group-prefixed-name group server)
1077                       (list (or (imap-mailbox-get
1078                                  'uidvalidity group nnimap-server-buffer)
1079                                 (imap-mailbox-status
1080                                  group 'uidvalidity nnimap-server-buffer))
1081                             (or (imap-mailbox-get
1082                                  'uidnext group nnimap-server-buffer)
1083                                 (imap-mailbox-status
1084                                  group 'uidnext nnimap-server-buffer))
1085                             (or (imap-mailbox-get
1086                                  'unseen group nnimap-server-buffer)
1087                                 (imap-mailbox-status
1088                                  group 'unseen nnimap-server-buffer))
1089                             str)
1090                       nnimap-mailbox-info)))))))
1091      (gnus-message 5 "nnimap: Checking mailboxes...done")      (gnus-message 5 "nnimap: Checking mailboxes...done")
1092      'active))      'active))
1093    
1094  (deffoo nnimap-request-update-info-internal (group info &optional server)  (deffoo nnimap-request-update-info-internal (group info &optional server)
1095    (when (nnimap-possibly-change-group group server)    (when (nnimap-possibly-change-group group server)
1096      (when info;; xxx what does this mean? should we create a info?      (when info ;; xxx what does this mean? should we create a info?
1097        (with-current-buffer nnimap-server-buffer        (with-current-buffer nnimap-server-buffer
1098          (gnus-message 5 "nnimap: Updating info for %s..."          (gnus-message 5 "nnimap: Updating info for %s..."
1099                        (gnus-info-group info))                        (gnus-info-group info))
# Line 887  function is generally only called when G Line 1121  function is generally only called when G
1121              (gnus-info-set-read info seen)))              (gnus-info-set-read info seen)))
1122    
1123          (mapcar (lambda (pred)          (mapcar (lambda (pred)
1124                    (when (and (nnimap-mark-permanent-p (cdr pred))                    (when (or (eq (cdr pred) 'recent)
1125                               (member (nnimap-mark-to-flag (cdr pred))                              (and (nnimap-mark-permanent-p (cdr pred))
1126                                       (imap-mailbox-get 'flags)))                                   (member (nnimap-mark-to-flag (cdr pred))
1127                                             (imap-mailbox-get 'flags))))
1128                      (gnus-info-set-marks                      (gnus-info-set-marks
1129                       info                       info
1130                       (nnimap-update-alist-soft                       (gnus-update-alist-soft
1131                        (cdr pred)                        (cdr pred)
1132                        (gnus-compress-sequence                        (gnus-compress-sequence
1133                         (imap-search (nnimap-mark-to-predicate (cdr pred))))                         (imap-search (nnimap-mark-to-predicate (cdr pred))))
# Line 900  function is generally only called when G Line 1135  function is generally only called when G
1135                       t)))                       t)))
1136                  gnus-article-mark-lists)                  gnus-article-mark-lists)
1137    
1138          ;; nnimap mark dormant article as ticked too (for other clients)          (when nnimap-importantize-dormant
1139          ;; so we remove that mark for gnus since we support dormant            ;; nnimap mark dormant article as ticked too (for other clients)
1140          (gnus-info-set-marks            ;; so we remove that mark for gnus since we support dormant
1141           info            (gnus-info-set-marks
1142           (nnimap-update-alist-soft             info
1143            'tick             (gnus-update-alist-soft
1144            (gnus-remove-from-range              'tick
1145             (cdr-safe (assoc 'tick (gnus-info-marks info)))              (gnus-remove-from-range
1146             (cdr-safe (assoc 'dormant (gnus-info-marks info))))               (cdr-safe (assoc 'tick (gnus-info-marks info)))
1147            (gnus-info-marks info))               (cdr-safe (assoc 'dormant (gnus-info-marks info))))
1148           t)              (gnus-info-marks info))
1149               t))
1150    
1151          (gnus-message 5 "nnimap: Updating info for %s...done"          (gnus-message 5 "nnimap: Updating info for %s...done"
1152                        (gnus-info-group info))                        (gnus-info-group info))
# Line 932  function is generally only called when G Line 1168  function is generally only called when G
1168                  (what  (nth 1 action))                  (what  (nth 1 action))
1169                  (cmdmarks (nth 2 action))                  (cmdmarks (nth 2 action))
1170                  marks)                  marks)
1171                ;; bookmark can't be stored (not list/range
1172                (setq cmdmarks (delq 'bookmark cmdmarks))
1173                ;; killed can't be stored (not list/range
1174                (setq cmdmarks (delq 'killed cmdmarks))
1175                ;; unsent are for nndraft groups only
1176                (setq cmdmarks (delq 'unsent cmdmarks))
1177              ;; cache flags are pointless on the server              ;; cache flags are pointless on the server
1178              (setq cmdmarks (delq 'cache cmdmarks))              (setq cmdmarks (delq 'cache cmdmarks))
1179              ;; flag dormant articles as ticked              ;; seen flags are local to each gnus
1180              (if (memq 'dormant cmdmarks)              (setq cmdmarks (delq 'seen cmdmarks))
1181                  (setq cmdmarks (cons 'tick cmdmarks)))              ;; recent marks can't be set
1182                (setq cmdmarks (delq 'recent cmdmarks))
1183                (when nnimap-importantize-dormant
1184                  ;; flag dormant articles as ticked
1185                  (if (memq 'dormant cmdmarks)
1186                      (setq cmdmarks (cons 'tick cmdmarks))))
1187              ;; remove stuff we are forbidden to store              ;; remove stuff we are forbidden to store
1188              (mapcar (lambda (mark)              (mapcar (lambda (mark)
1189                        (if (imap-message-flag-permanent-p                        (if (imap-message-flag-permanent-p
# Line 960  function is generally only called when G Line 1207  function is generally only called when G
1207    nil)    nil)
1208    
1209  (defun nnimap-split-fancy ()  (defun nnimap-split-fancy ()
1210    "Like nnmail-split-fancy, but uses nnimap-split-fancy."    "Like the function `nnmail-split-fancy', but uses `nnimap-split-fancy'."
1211    (let ((nnmail-split-fancy nnimap-split-fancy))    (let ((nnmail-split-fancy nnimap-split-fancy))
1212      (nnmail-split-fancy)))      (nnmail-split-fancy)))
1213    
# Line 982  function is generally only called when G Line 1229  function is generally only called when G
1229                (goto-char (point-min))                (goto-char (point-min))
1230                (when (and (if (stringp regexp)                (when (and (if (stringp regexp)
1231                               (progn                               (progn
1232                                 (setq regrepp (string-match "\\\\[0-9&]" group))                                 (if (not (stringp group))
1233                                       (setq group (eval group))
1234                                     (setq regrepp
1235                                           (string-match "\\\\[0-9&]" group)))
1236                                 (re-search-forward regexp nil t))                                 (re-search-forward regexp nil t))
1237                             (funcall regexp group))                             (funcall regexp group))
1238                           ;; Don't enter the article into the same group twice.                           ;; Don't enter the article into the same group twice.
# Line 1004  function is generally only called when G Line 1254  function is generally only called when G
1254    
1255  (defun nnimap-split-find-rule (server inbox)  (defun nnimap-split-find-rule (server inbox)
1256    (if (and (listp nnimap-split-rule) (listp (car nnimap-split-rule))    (if (and (listp nnimap-split-rule) (listp (car nnimap-split-rule))
1257             (list (cdar nnimap-split-rule)) (listp (cadar nnimap-split-rule)))             (list (cdar nnimap-split-rule)) (listp (cadar nnimap-split-rule)))
1258        ;; extended format        ;; extended format
1259        (cadr (nnimap-assoc-match inbox (cdr (nnimap-assoc-match        (cadr (nnimap-assoc-match inbox (cdr (nnimap-assoc-match
1260                                              server nnimap-split-rule))))                                              server nnimap-split-rule))))
# Line 1021  function is generally only called when G Line 1271  function is generally only called when G
1271        (let (rule inbox removeorig (inboxes (nnimap-split-find-inbox server)))        (let (rule inbox removeorig (inboxes (nnimap-split-find-inbox server)))
1272          ;; iterate over inboxes          ;; iterate over inboxes
1273          (while (and (setq inbox (pop inboxes))          (while (and (setq inbox (pop inboxes))
1274                      (nnimap-possibly-change-group inbox));; SELECT                      (nnimap-possibly-change-group inbox)) ;; SELECT
1275            ;; find split rule for this server / inbox            ;; find split rule for this server / inbox
1276            (when (setq rule (nnimap-split-find-rule server inbox))            (when (setq rule (nnimap-split-find-rule server inbox))
1277              ;; iterate over articles              ;; iterate over articles
1278              (dolist (article (imap-search nnimap-split-predicate))              (dolist (article (imap-search nnimap-split-predicate))
1279                (when (nnimap-request-head article)                (when (if (if (eq nnimap-split-download-body 'default)
1280                                nnimap-split-download-body-default
1281                              nnimap-split-download-body)
1282                            (and (nnimap-request-article article)
1283                                 (with-current-buffer nntp-server-buffer (mail-narrow-to-head)))
1284                          (nnimap-request-head article))
1285                  ;; copy article to right group(s)                  ;; copy article to right group(s)
1286                  (setq removeorig nil)                  (setq removeorig nil)
1287                  (dolist (to-group (nnimap-split-to-groups rule))                  (dolist (to-group (nnimap-split-to-groups rule))
1288                    (if (imap-message-copy (number-to-string article)                    (cond ((eq to-group 'junk)
1289                                           to-group nil 'nocopyuid)                           (message "IMAP split removed %s:%s:%d" server inbox
1290                        (progn                                    article)
1291                          (message "IMAP split moved %s:%s:%d to %s" server inbox                           (setq removeorig t))
1292                                   article to-group)                          ((imap-message-copy (number-to-string article)
1293                          (setq removeorig t)                                              to-group nil 'nocopyuid)
1294                          ;; Add the group-art list to the history list.                           (message "IMAP split moved %s:%s:%d to %s" server
1295                          (push (list (cons to-group 0)) nnmail-split-history))                                    inbox article to-group)
1296                      (message "IMAP split failed to move %s:%s:%d to %s" server                           (setq removeorig t)
1297                               inbox article to-group)))                           (when nnmail-cache-accepted-message-ids
1298                               (with-current-buffer nntp-server-buffer
1299                                 (let (msgid)
1300                                   (and (setq msgid
1301                                              (nnmail-fetch-field "message-id"))
1302                                        (nnmail-cache-insert msgid
1303                                                             to-group
1304                                                             (nnmail-fetch-field "subject"))))))
1305                             ;; Add the group-art list to the history list.
1306                             (push (list (cons to-group 0)) nnmail-split-history))
1307                            (t
1308                             (message "IMAP split failed to move %s:%s:%d to %s"
1309                                      server inbox article to-group))))
1310                    (if (if (eq nnimap-split-download-body 'default)
1311                            nnimap-split-download-body-default
1312                          nnimap-split-download-body)
1313                        (widen))
1314                  ;; remove article if it was successfully copied somewhere                  ;; remove article if it was successfully copied somewhere
1315                  (and removeorig                  (and removeorig
1316                       (imap-message-flags-add (format "%d" article)                       (imap-message-flags-add (format "%d" article)
1317                                               "\\Seen \\Deleted")))))                                               "\\Seen \\Deleted")))))
1318            (when (imap-mailbox-select inbox);; just in case            (when (imap-mailbox-select inbox) ;; just in case
1319              ;; todo: UID EXPUNGE (if available) to remove splitted articles              ;; todo: UID EXPUNGE (if available) to remove splitted articles
1320              (imap-mailbox-expunge)              (imap-mailbox-expunge)
1321              (imap-mailbox-close)))              (imap-mailbox-close)))
1322            (when nnmail-cache-accepted-message-ids
1323              (nnmail-cache-close))
1324          t))))          t))))
1325    
1326  (deffoo nnimap-request-scan (&optional group server)  (deffoo nnimap-request-scan (&optional group server)
# Line 1062  function is generally only called when G Line 1335  function is generally only called when G
1335        (nnimap-before-find-minmax-bugworkaround)        (nnimap-before-find-minmax-bugworkaround)
1336        (dolist (pattern (nnimap-pattern-to-list-arguments        (dolist (pattern (nnimap-pattern-to-list-arguments
1337                          nnimap-list-pattern))                          nnimap-list-pattern))
1338          (dolist (mbx (imap-mailbox-lsub "*" (car pattern) nil          (dolist (mbx (imap-mailbox-lsub (cdr pattern) (car pattern) nil
1339                                          nnimap-server-buffer))                                          nnimap-server-buffer))
1340            (or (catch 'found            (or (catch 'found
1341                  (dolist (mailbox (imap-mailbox-get 'list-flags mbx                  (dolist (mailbox (imap-mailbox-get 'list-flags mbx
# Line 1072  function is generally only called when G Line 1345  function is generally only called when G
1345                  nil)                  nil)
1346                (let ((info (nnimap-find-minmax-uid mbx 'examine)))                (let ((info (nnimap-find-minmax-uid mbx 'examine)))
1347                  (when info                  (when info
1348                   (insert (format "\"%s\" %d %d y\n"                    (insert (format "\"%s\" %d %d y\n"
1349                                   mbx (or (nth 2 info) 0)                                    mbx (or (nth 2 info) 0)
1350                                   (max 1 (or (nth 1 info) 1)))))))))                                    (max 1 (or (nth 1 info) 1)))))))))
1351        (gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s...done"        (gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s...done"
1352                      (if (> (length server) 0) " on " "") server))                      (if (> (length server) 0) " on " "") server))
1353      t))      t))
# Line 1082  function is generally only called when G Line 1355  function is generally only called when G
1355  (deffoo nnimap-request-create-group (group &optional server args)  (deffoo nnimap-request-create-group (group &optional server args)
1356    (when (nnimap-possibly-change-server server)    (when (nnimap-possibly-change-server server)
1357      (or (imap-mailbox-status group 'uidvalidity nnimap-server-buffer)      (or (imap-mailbox-status group 'uidvalidity nnimap-server-buffer)
1358          (imap-mailbox-create group nnimap-server-buffer))))          (imap-mailbox-create group nnimap-server-buffer)
1359            (nnheader-report 'nnimap "%S"
1360                             (imap-error-text nnimap-server-buffer)))))
1361    
1362  (defun nnimap-time-substract (time1 time2)  (defun nnimap-time-substract (time1 time2)
1363    "Return TIME for TIME1 - TIME2."    "Return TIME for TIME1 - TIME2."
# Line 1108  function is generally only called when G Line 1383  function is generally only called when G
1383    (gnus-message 5 "nnimap: Marking article %d for deletion..."    (gnus-message 5 "nnimap: Marking article %d for deletion..."
1384                  imap-current-message))                  imap-current-message))
1385    
1386    (defun nnimap-expiry-target (arts group server)
1387      (unless (eq nnmail-expiry-target 'delete)
1388        (with-temp-buffer
1389          (dolist (art arts)
1390            (nnimap-request-article art group server (current-buffer))
1391            ;; hints for optimization in `nnimap-request-accept-article'
1392            (let ((nnimap-current-move-article art)
1393                  (nnimap-current-move-group group)
1394                  (nnimap-current-move-server server))
1395              (nnmail-expiry-target-group nnmail-expiry-target group))))
1396        ;; It is not clear if `nnmail-expiry-target' somehow cause the
1397        ;; current group to be changed or not, so we make sure here.
1398        (nnimap-possibly-change-group group server)))
1399    
1400  ;; Notice that we don't actually delete anything, we just mark them deleted.  ;; Notice that we don't actually delete anything, we just mark them deleted.
1401  (deffoo nnimap-request-expire-articles (articles group &optional server force)  (deffoo nnimap-request-expire-articles (articles group &optional server force)
1402    (let ((artseq (gnus-compress-sequence articles)))    (let ((artseq (gnus-compress-sequence articles)))
1403      (when (and artseq (nnimap-possibly-change-group group server))      (when (and artseq (nnimap-possibly-change-group group server))
1404        (with-current-buffer nnimap-server-buffer        (with-current-buffer nnimap-server-buffer
1405          (if force          (let ((days (or (and nnmail-expiry-wait-function
1406              (and (imap-message-flags-add                               (funcall nnmail-expiry-wait-function group))
1407                    (imap-range-to-message-set artseq) "\\Deleted")                          nnmail-expiry-wait)))
1408                   (setq articles nil))            (cond ((or force (eq days 'immediate))
1409            (let ((days (or (and nnmail-expiry-wait-function                   (let ((oldarts (imap-search
1410                                 (funcall nnmail-expiry-wait-function group))                                   (concat "UID "
1411                            nnmail-expiry-wait)))                                           (imap-range-to-message-set artseq)))))
1412              (cond ((eq days 'immediate)                     (when oldarts
1413                     (and (imap-message-flags-add                       (nnimap-expiry-target oldarts group server)
1414                           (imap-range-to-message-set artseq) "\\Deleted")                       (when (imap-message-flags-add
1415                          (setq articles nil)))                              (imap-range-to-message-set
1416                    ((numberp days)                               (gnus-compress-sequence oldarts)) "\\Deleted")
1417                     (let ((oldarts (imap-search                         (setq articles (gnus-set-difference
1418                                     (format "UID %s NOT SINCE %s"                                         articles oldarts))))))
1419                                             (imap-range-to-message-set artseq)                  ((numberp days)
1420                                             (nnimap-date-days-ago days))))                   (let ((oldarts (imap-search
1421                           (imap-fetch-data-hook                                   (format nnimap-expunge-search-string
1422                            '(nnimap-request-expire-articles-progress)))                                           (imap-range-to-message-set artseq)
1423                       (and oldarts                                           (nnimap-date-days-ago days))))
1424                            (imap-message-flags-add                         (imap-fetch-data-hook
1425                             (imap-range-to-message-set                          '(nnimap-request-expire-articles-progress)))
1426                              (gnus-compress-sequence oldarts))                     (when oldarts
1427                             "\\Deleted")                       (nnimap-expiry-target oldarts group server)
1428                            (setq articles (gnus-set-difference                       (when (imap-message-flags-add
1429                                            articles oldarts)))))))))))                              (imap-range-to-message-set
1430                                 (gnus-compress-sequence oldarts)) "\\Deleted")
1431                           (setq articles (gnus-set-difference
1432                                           articles oldarts)))))))))))
1433    ;; return articles not deleted    ;; return articles not deleted
1434    articles)    articles)
1435    
# Line 1158  function is generally only called when G Line 1450  function is generally only called when G
1450                 (setq result (eval accept-form))                 (setq result (eval accept-form))
1451                 (kill-buffer buf)                 (kill-buffer buf)
1452                 result)                 result)
1453               (nnimap-request-expire-articles (list article) group server t))               (imap-message-flags-add
1454                  (imap-range-to-message-set (list article))
1455                  "\\Deleted" 'silent nnimap-server-buffer))
1456          result))))          result))))
1457    
1458  (deffoo nnimap-request-accept-article (group &optional server last)  (deffoo nnimap-request-accept-article (group &optional server last)
# Line 1178  function is generally only called when G Line 1472  function is generally only called when G
1472                      ;; remove any 'From blabla' lines, some IMAP servers                      ;; remove any 'From blabla' lines, some IMAP servers
1473                      ;; reject the entire message otherwise.                      ;; reject the entire message otherwise.
1474                      (when (looking-at "^From[^:]")                      (when (looking-at "^From[^:]")
1475                        (kill-region (point) (progn (forward-line) (point))))                        (delete-region (point) (progn (forward-line) (point))))
1476                      ;; turn into rfc822 format (\r\n eol's)                      ;; turn into rfc822 format (\r\n eol's)
1477                      (while (search-forward "\n" nil t)                      (while (search-forward "\n" nil t)
1478                        (replace-match "\r\n")))                        (replace-match "\r\n"))
1479                    ;; this 'or' is for Cyrus server bug                      (when nnmail-cache-accepted-message-ids
1480                    (or (null (imap-current-mailbox nnimap-server-buffer))                        (nnmail-cache-insert (nnmail-fetch-field "message-id")
1481                        (imap-mailbox-unselect nnimap-server-buffer))                                             group
1482                                               (nnmail-fetch-field "subject"))))
1483                      (when (and last nnmail-cache-accepted-message-ids)
1484                        (nnmail-cache-close))
1485                      ;; this 'or' is for Cyrus server bug
1486                      (or (null (imap-current-mailbox nnimap-server-buffer))
1487                          (imap-mailbox-unselect nnimap-server-buffer))
1488                    (imap-message-append group (current-buffer) nil nil                    (imap-message-append group (current-buffer) nil nil
1489                                         nnimap-server-buffer)))                                         nnimap-server-buffer)))
1490            (cons group (nth 1 uid))            (cons group (nth 1 uid))
# Line 1205  function is generally only called when G Line 1505  function is generally only called when G
1505    
1506  (defun nnimap-expunge (mailbox server)  (defun nnimap-expunge (mailbox server)
1507    (when (nnimap-possibly-change-group mailbox server)    (when (nnimap-possibly-change-group mailbox server)
1508      (imap-mailbox-expunge nnimap-server-buffer)))      (imap-mailbox-expunge nil nnimap-server-buffer)))
1509    
1510  (defun nnimap-acl-get (mailbox server)  (defun nnimap-acl-get (mailbox server)
1511    (when (nnimap-possibly-change-server server)    (when (nnimap-possibly-change-server server)
# Line 1253  function is generally only called when G Line 1553  function is generally only called when G
1553    (mapcar    (mapcar
1554     (lambda (pair)                       ; cdr is the mark     (lambda (pair)                       ; cdr is the mark
1555       (or (assoc (cdr pair)       (or (assoc (cdr pair)
1556                  '((read . "SEEN")                  '((read . "SEEN")
1557                    (tick . "FLAGGED")                    (tick . "FLAGGED")
1558                    (draft . "DRAFT")                    (draft . "DRAFT")
1559                    (reply . "ANSWERED")))                    (recent . "RECENT")
1560           (cons (cdr pair)                    (reply . "ANSWERED")))
1561                 (format "KEYWORD gnus-%s" (symbol-name (cdr pair))))))           (cons (cdr pair)
1562                   (format "KEYWORD gnus-%s" (symbol-name (cdr pair))))))
1563     (cons '(read . read) gnus-article-mark-lists)))     (cons '(read . read) gnus-article-mark-lists)))
1564    
1565  (defun nnimap-mark-to-predicate (pred)  (defun nnimap-mark-to-predicate (pred)
# Line 1271  to be used within a IMAP SEARCH query." Line 1572  to be used within a IMAP SEARCH query."
1572    (mapcar    (mapcar
1573     (lambda (pair)     (lambda (pair)
1574       (or (assoc (cdr pair)       (or (assoc (cdr pair)
1575                  '((read . "\\Seen")                  '((read . "\\Seen")
1576                    (tick . "\\Flagged")                    (tick . "\\Flagged")
1577                    (draft . "\\Draft")                    (draft . "\\Draft")
1578                    (reply . "\\Answered")))                    (recent . "\\Recent")
1579           (cons (cdr pair)                    (reply . "\\Answered")))
1580                 (format "gnus-%s" (symbol-name (cdr pair))))))           (cons (cdr pair)
1581                   (format "gnus-%s" (symbol-name (cdr pair))))))
1582     (cons '(read . read) gnus-article-mark-lists)))     (cons '(read . read) gnus-article-mark-lists)))
1583    
1584  (defun nnimap-mark-to-flag-1 (preds)  (defun nnimap-mark-to-flag-1 (preds)
# Line 1306  be used in a STORE FLAGS command." Line 1608  be used in a STORE FLAGS command."
1608    "Return t iff MARK can be permanently (between IMAP sessions) saved on articles, in GROUP."    "Return t iff MARK can be permanently (between IMAP sessions) saved on articles, in GROUP."
1609    (imap-message-flag-permanent-p (nnimap-mark-to-flag mark)))    (imap-message-flag-permanent-p (nnimap-mark-to-flag mark)))
1610    
 (defun nnimap-remassoc (key alist)  
   "Delete by side effect any elements of LIST whose car is `equal' to KEY.  
 The modified LIST is returned.  If the first member  
 of LIST has a car that is `equal' to KEY, there is no way to remove it  
 by side effect; therefore, write `(setq foo (remassoc key foo))' to be  
 sure of changing the value of `foo'."  
   (when alist  
     (if (equal key (caar alist))  
         (cdr alist)  
       (setcdr alist (nnimap-remassoc key (cdr alist)))  
       alist)))  
   
 (defun nnimap-update-alist-soft (key value alist)  
   (if value  
       (cons (cons key value) (nnimap-remassoc key alist))  
     (nnimap-remassoc key alist)))  
   
1611  (when nnimap-debug  (when nnimap-debug
1612    (require 'trace)    (require 'trace)
1613    (buffer-disable-undo (get-buffer-create nnimap-debug))    (buffer-disable-undo (get-buffer-create nnimap-debug-buffer))
1614    (mapcar (lambda (f) (trace-function-background f nnimap-debug))    (mapcar (lambda (f) (trace-function-background f nnimap-debug-buffer))
1615          '(            '(
1616            nnimap-possibly-change-server              nnimap-possibly-change-server
1617            nnimap-verify-uidvalidity              nnimap-verify-uidvalidity
1618            nnimap-find-minmax-uid              nnimap-find-minmax-uid
1619            nnimap-before-find-minmax-bugworkaround              nnimap-before-find-minmax-bugworkaround
1620            nnimap-possibly-change-group              nnimap-possibly-change-group
1621            ;;nnimap-replace-whitespace              ;;nnimap-replace-whitespace
1622            nnimap-retrieve-headers-progress              nnimap-retrieve-headers-progress
1623            nnimap-retrieve-which-headers              nnimap-retrieve-which-headers
1624            nnimap-group-overview-filename              nnimap-group-overview-filename
1625            nnimap-retrieve-headers-from-file              nnimap-retrieve-headers-from-file
1626            nnimap-retrieve-headers-from-server              nnimap-retrieve-headers-from-server
1627            nnimap-retrieve-headers              nnimap-retrieve-headers
1628            nnimap-open-connection              nnimap-open-connection
1629            nnimap-open-server              nnimap-open-server
1630            nnimap-server-opened              nnimap-server-opened
1631            nnimap-close-server              nnimap-close-server
1632            nnimap-request-close              nnimap-request-close
1633            nnimap-status-message              nnimap-status-message
1634            ;;nnimap-demule              ;;nnimap-demule
1635            nnimap-request-article-part              nnimap-request-article-part
1636            nnimap-request-article              nnimap-request-article
1637            nnimap-request-head              nnimap-request-head
1638            nnimap-request-body              nnimap-request-body
1639            nnimap-request-group              nnimap-request-group
1640            nnimap-close-group              nnimap-close-group
1641            nnimap-pattern-to-list-arguments              nnimap-pattern-to-list-arguments
1642            nnimap-request-list              nnimap-request-list
1643            nnimap-request-post              nnimap-request-post
1644            nnimap-retrieve-groups              nnimap-retrieve-groups
1645            nnimap-request-update-info-internal              nnimap-request-update-info-internal
1646            nnimap-request-type              nnimap-request-type
1647            nnimap-request-set-mark              nnimap-request-set-mark
1648            nnimap-split-to-groups              nnimap-split-to-groups
1649            nnimap-split-find-rule              nnimap-split-find-rule
1650            nnimap-split-find-inbox              nnimap-split-find-inbox
1651            nnimap-split-articles              nnimap-split-articles
1652            nnimap-request-scan              nnimap-request-scan
1653            nnimap-request-newgroups              nnimap-request-newgroups
1654            nnimap-request-create-group              nnimap-request-create-group
1655            nnimap-time-substract              nnimap-time-substract
1656            nnimap-date-days-ago              nnimap-date-days-ago
1657            nnimap-request-expire-articles-progress              nnimap-request-expire-articles-progress
1658            nnimap-request-expire-articles              nnimap-request-expire-articles
1659            nnimap-request-move-article              nnimap-request-move-article
1660            nnimap-request-accept-article              nnimap-request-accept-article
1661            nnimap-request-delete-group              nnimap-request-delete-group
1662            nnimap-request-rename-group              nnimap-request-rename-group
1663            gnus-group-nnimap-expunge              gnus-group-nnimap-expunge
1664            gnus-group-nnimap-edit-acl              gnus-group-nnimap-edit-acl
1665            gnus-group-nnimap-edit-acl-done              gnus-group-nnimap-edit-acl-done
1666            nnimap-group-mode-hook              nnimap-group-mode-hook
1667            nnimap-mark-to-predicate              nnimap-mark-to-predicate
1668            nnimap-mark-to-flag-1              nnimap-mark-to-flag-1
1669            nnimap-mark-to-flag              nnimap-mark-to-flag
1670            nnimap-mark-permanent-p              nnimap-mark-permanent-p
1671            nnimap-remassoc              )))
           nnimap-update-alist-soft  
           )))  
1672    
1673  (provide 'nnimap)  (provide 'nnimap)
1674    

Legend:
Removed from v.1.6.2.4  
changed lines
  Added in v.1.6.2.5

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26