* nnimap.el (nnimap-need-unselect-to-notice-new-mail)
[gnus] / lisp / nnimap.el
index cbb2f73..d597770 100644 (file)
 
 ;;; Code:
 
-(eval-and-compile
-  (require 'cl)
-  (require 'imap))
-
+(require 'imap)
 (require 'nnoo)
 (require 'nnmail)
 (require 'nnheader)
 
 (defconst nnimap-version "nnimap 1.0")
 
+(defgroup nnimap nil
+  "Reading IMAP mail with Gnus."
+  :group 'gnus)
+
 (defvoo nnimap-address nil
   "Address of physical IMAP server.  If nil, use the virtual server's name.")
 
@@ -84,20 +85,36 @@ If nil, defaults to 993 for SSL connections and 143 otherwise.")
 
 ;; Splitting variables
 
-(defvar nnimap-split-crosspost t
+(defcustom nnimap-split-crosspost t
   "If non-nil, do crossposting if several split methods match the mail.
-If nil, the first match found will be used.")
+If nil, the first match found will be used."
+  :group 'nnimap
+  :type 'boolean)
 
-(defvar nnimap-split-inbox nil
-  "*Name of mailbox to split mail from.
+(defcustom nnimap-split-inbox nil
+  "Name of mailbox to split mail from.
 
 Mail is read from this mailbox and split according to rules in
 `nnimap-split-rule'.
 
-This can be a string or a list of strings.")
+This can be a string or a list of strings."
+  :group 'nnimap
+  :type '(choice (string)
+                (repeat string)))
+
+(define-widget 'nnimap-strict-function 'function
+  "This widget only matches values that are functionp.
 
-(defvar nnimap-split-rule nil
-  "*Mail will be split according to theese rules.
+Warning: This means that a value that is the symbol of a not yet
+loaded function will not match.  Use with care."
+  :match 'nnimap-strict-function-match)
+
+(defun nnimap-strict-function-match (widget value)
+  "Ignoring WIDGET, match if VALUE is a function."
+  (functionp value))
+
+(defcustom nnimap-split-rule nil
+  "Mail will be split according to theese rules.
 
 Mail is read from mailbox(es) specified in `nnimap-split-inbox'.
 
@@ -106,7 +123,7 @@ If you'd like, for instance, one mail group for mail from the
 everything else in the incoming mailbox, you could do something like
 this:
 
-(setq nnimap-split-rule '((\"INBOX.gnus-imap\"   \"From:.*gnus-imap\")
+\(setq nnimap-split-rule '((\"INBOX.gnus-imap\"   \"From:.*gnus-imap\")
                          (\"INBOX.junk\"        \"Subject:.*buy\")))
 
 As you can see, `nnimap-split-rule' is a list of lists, where the first
@@ -127,7 +144,7 @@ To allow for different split rules on different virtual servers, and
 even different split rules in different inboxes on the same server,
 the syntax of this variable have been extended along the lines of:
 
-(setq nnimap-split-rule
+\(setq nnimap-split-rule
       '((\"my1server\"    (\".*\"    ((\"ding\"    \"ding@gnus.org\")
                                  (\"junk\"    \"From:.*Simon\")))
        (\"my2server\"    (\"INBOX\" nnimap-split-fancy))
@@ -139,17 +156,65 @@ may apply to several servers.  In the example, the servers
 \"my3server\" and \"my4server\" both use the same rules.  Similarly,
 the inbox string is also a regexp.  The actual splitting rules are as
 before, either a function, or a list with group/regexp or
-group/function elements.")
-
-(defvar nnimap-split-predicate "UNSEEN UNDELETED"
+group/function elements."
+  :group 'nnimap
+  :type '(choice :tag "Rule type"
+                (repeat :menu-tag "Single-server"
+                        :tag "Single-server list"
+                        (list (string :tag "Mailbox")
+                              (choice :tag "Predicate"
+                                      (regexp :tag "A regexp")
+                                      (nnimap-strict-function :tag "A function"))))
+                (choice :menu-tag "A function"
+                        :tag "A function"
+                        (function-item nnimap-split-fancy)
+                        (function-item nnmail-split-fancy)
+                        (nnimap-strict-function :tag "User-defined function"))
+                (repeat :menu-tag "Multi-server (extended)"
+                        :tag "Multi-server list"
+                        (list (regexp :tag "Server regexp") 
+                              (list (regexp :tag "Incoming Mailbox regexp")
+                                    (repeat :tag "Rules for matching server(s) and mailbox(es)"
+                                            (list (string :tag "Destination mailbox")
+                                                  (choice :tag "Predicate"
+                                                          (regexp :tag "A Regexp")
+                                                          (nnimap-strict-function :tag "A Function")))))))))
+
+(defcustom nnimap-split-predicate "UNSEEN UNDELETED"
   "The predicate used to find articles to split.
 If you use another IMAP client to peek on articles but always would
 like nnimap to split them once it's started, you could change this to
 \"UNDELETED\". Other available predicates are available in
-RFC2060 section 6.4.4.")
-
-(defvar nnimap-split-fancy nil
-  "Like `nnmail-split-fancy', which see.")
+RFC2060 section 6.4.4."
+  :group 'nnimap
+  :type 'string)
+
+(defcustom nnimap-split-fancy nil
+  "Like `nnmail-split-fancy', which see."
+  :group 'nnimap
+  :type 'sexp)
+
+;; Performance / bug workaround variables
+
+(defcustom nnimap-close-asynchronous nil
+  "Close mailboxes asynchronously in `nnimap-close-group'.
+This means that errors cought by nnimap when closing the mailbox will
+not prevent Gnus from updating the group status, which may be harmful.
+However, it increases speed."
+  :type 'boolean
+  :group 'nnimap)
+
+(defcustom nnimap-dont-close t
+  "Never close mailboxes.
+This increases the speed of closing mailboxes (quiting group) but may
+decrease the speed of selecting another mailbox later.  Re-selecting
+the same mailbox will be faster though."
+  :type 'boolean
+  :group 'nnimap)
+
+(defvoo nnimap-need-unselect-to-notice-new-mail nil
+  "Unselect mailboxes before looking for new mail in them.
+Some servers seem to need this under some circumstances.")
 
 ;; Authorization / Privacy variables
 
@@ -254,7 +319,7 @@ similar which you wouldn't want to set up a mailing list for, you can
 use this to make replies go directly to the group.")
 
 (defvoo nnimap-expunge-search-string "UID %s NOT SINCE %s"
-  "*IMAP search command to use for articles that are to be expired.
+  "IMAP search command to use for articles that are to be expired.
 The first %s is replaced by a UID set of articles to search on,
 and the second %s is replaced by a date criterium.
 
@@ -264,7 +329,7 @@ instead of the internal date of messages.  See section 6.4.4 of RFC
 2060 for more information on valid strings.")
 
 (defvoo nnimap-importantize-dormant t
-  "*If non-nil, mark \"dormant\" articles as \"ticked\" for other IMAP clients.
+  "If non-nil, mark \"dormant\" articles as \"ticked\" for other IMAP clients.
 Note that within Gnus, dormant articles will still (only) be
 marked as ticked.  This is to make \"dormant\" articles stand out,
 just like \"ticked\" articles, in other IMAP clients.")
@@ -368,16 +433,18 @@ If SERVER is nil, uses the current server."
 (defun nnimap-before-find-minmax-bugworkaround ()
   "Function called before iterating through mailboxes with
 `nnimap-find-minmax-uid'."
-  ;; XXX this is for UoW imapd problem, it doesn't notice new mail in
-  ;; currently selected mailbox without a re-select/examine.
-  (or (null (imap-current-mailbox nnimap-server-buffer))
-      (imap-mailbox-unselect nnimap-server-buffer)))
+  (when nnimap-need-unselect-to-notice-new-mail
+    ;; XXX this is for UoW imapd problem, it doesn't notice new mail in
+    ;; currently selected mailbox without a re-select/examine.
+    (or (null (imap-current-mailbox nnimap-server-buffer))
+       (imap-mailbox-unselect nnimap-server-buffer))))
 
 (defun nnimap-find-minmax-uid (group &optional examine)
   "Find lowest and highest active article nummber in GROUP.
 If EXAMINE is non-nil the group is selected read-only."
   (with-current-buffer nnimap-server-buffer
-    (when (imap-mailbox-select group examine)
+    (when (or (string= group (imap-current-mailbox))
+             (imap-mailbox-select group examine))
       (let (minuid maxuid)
        (when (> (imap-mailbox-get 'exists) 0)
          (imap-fetch "1,*" "UID" nil 'nouidfetch)
@@ -434,7 +501,7 @@ If EXAMINE is non-nil the group is selected read-only."
              mbx imap-current-mailbox
              headers (nnimap-demule
                       (if (imap-capability 'IMAP4rev1)
-                     ;; xxx don't just use car? alist doesn't contain
+                          ;; xxx don't just use car? alist doesn't contain
                           ;; anything else now, but it might...
                           (nth 2 (car (imap-message-get uid 'BODYDETAIL)))
                         (imap-message-get uid 'RFC822.HEADER)))
@@ -792,15 +859,16 @@ function is generally only called when Gnus is shutting down."
     (when (and (imap-opened)
               (nnimap-possibly-change-group group server))
       (case nnimap-expunge-on-close
-       ('always (imap-mailbox-expunge)
-                (imap-mailbox-close))
-       ('ask (if (and (imap-search "DELETED")
-                      (gnus-y-or-n-p (format
-                                      "Expunge articles in group `%s'? "
-                                      imap-current-mailbox)))
-                 (progn (imap-mailbox-expunge)
-                        (imap-mailbox-close))
-               (imap-mailbox-unselect)))
+       (always (unless nnimap-dont-close
+                 (imap-mailbox-expunge nnimap-close-asynchronous)
+                 (imap-mailbox-close nnimap-close-asynchronous)))
+       (ask (if (and (imap-search "DELETED")
+                     (gnus-y-or-n-p (format "Expunge articles in group `%s'? "
+                                            imap-current-mailbox)))
+                (unless nnimap-dont-close
+                  (imap-mailbox-expunge nnimap-close-asynchronous)
+                  (imap-mailbox-close nnimap-close-asynchronous))
+              (imap-mailbox-unselect)))
        (t (imap-mailbox-unselect)))
       (not imap-current-mailbox))))
 
@@ -896,8 +964,8 @@ function is generally only called when Gnus is shutting down."
                  ;; remove dupes
                  seen (sort seen '<)
                  seen (gnus-compress-sequence seen t)
-         ;; we can't return '(1) since this isn't a "list of ranges",
-        ;; and we can't return '((1)) since g-list-of-unread-articles
+                 ;; we can't return '(1) since this isn't a "list of ranges",
+                 ;; and we can't return '((1)) since g-list-of-unread-articles
                  ;; is buggy so we return '((1 . 1)).
                  seen (if (and (integerp (car seen))
                                (null (cdr seen)))
@@ -1071,17 +1139,17 @@ function is generally only called when Gnus is shutting down."
                         (message "IMAP split moved %s:%s:%d to %s" server
                                  inbox article to-group)
                         (setq removeorig t)
-                       ;; Add the group-art list to the history list.
+                        ;; Add the group-art list to the history list.
                         (push (list (cons to-group 0)) nnmail-split-history))
                        (t
                         (message "IMAP split failed to move %s:%s:%d to %s"
                                  server inbox article to-group))))
-            ;; remove article if it was successfully copied somewhere
+               ;; remove article if it was successfully copied somewhere
                (and removeorig
                     (imap-message-flags-add (format "%d" article)
                                             "\\Seen \\Deleted")))))
          (when (imap-mailbox-select inbox) ;; just in case
-       ;; todo: UID EXPUNGE (if available) to remove splitted articles
+           ;; todo: UID EXPUNGE (if available) to remove splitted articles
            (imap-mailbox-expunge)
            (imap-mailbox-close)))
        t))))
@@ -1154,7 +1222,10 @@ function is generally only called when Gnus is shutting down."
        (let ((nnimap-current-move-article art)
              (nnimap-current-move-group group)
              (nnimap-current-move-server server))
-         (nnmail-expiry-target-group nnmail-expiry-target group))))))
+         (nnmail-expiry-target-group nnmail-expiry-target group))))
+    ;; It is not clear if `nnmail-expiry-target' somehow cause the
+    ;; current group to be changed or not, so we make sure here.
+    (nnimap-possibly-change-group group server)))
 
 ;; Notice that we don't actually delete anything, we just mark them deleted.
 (deffoo nnimap-request-expire-articles (articles group &optional server force)
@@ -1259,7 +1330,7 @@ function is generally only called when Gnus is shutting down."
 
 (defun nnimap-expunge (mailbox server)
   (when (nnimap-possibly-change-group mailbox server)
-    (imap-mailbox-expunge nnimap-server-buffer)))
+    (imap-mailbox-expunge nil nnimap-server-buffer)))
 
 (defun nnimap-acl-get (mailbox server)
   (when (nnimap-possibly-change-server server)