diff lisp/gnus/nnimap.el @ 110465:b7b7e970d807

Merge changes made in Gnus trunk. gnus-group.el (gnus-group-line-format-alist): Have the ?U (unseen) spec inserr "*" if the group isn't active instead of 0. nnimap.el (nnimap-request-create-group): Implement. nnimap.el: Use the IMAP version of utf7-encode throughout. nnimap.el: Implement the nnimap article expunging interface method, and make it more general. gnus-group.el: Put back the nnimap autoloads needed to do the acl stuff. gnus-sum.el (gnus-summary-move-article): When respooling to the same method, this would bug out. nnimap.el (nnimap-request-group): When we have zero articles, return the right data to Gnus. nnimap.el (nnimap-request-expire-articles): Only delete articles immediately if the target is 'delete. nnmail.el (nnmail-expired-article-p): Allow returning the cutoff time for oldness in addition to being a predicate. nnimap.el: Implement nnimap expiry. nnimap.el (nnimap-request-move-article): Request the article before looking at what the Message-ID is. nnimap.el (nnimap-mark-and-expunge-incoming): Wait for the last sequence. gnus-sum.el (gnus-summary-move-article): Use gnus-server-equal to find out whether methods are equal. nnimap.el (nnimap-find-expired-articles): Don't refer to nnml-inhibit-expiry. nnmail.el (nnmail-expired-article-p): Fix typo: time-subtract. gnus-start.el (gnus-get-unread-articles): Fix the prefixed select method in the presence of many similar methods. When we have several similar methods, try to create as few extended methods as possible. gnus-sum.el (gnus-adjust-marked-articles): Hack to avoid adjusting marks for nnimap, which is seldom the right thing to do. gnus-int.el (gnus-open-server): Give a better error message in the "go offline" case. gnus-sum.el (gnus-adjust-marked-articles): Fix another typo. nnml.el (nnml-generate-nov-file): Fix variable name clobbering from previous patch. gnus-start.el (gnus-get-unread-articles): Get the extended method slightly later to avoid double-getting it.

--- a/lisp/gnus/nnimap.el	Tue Sep 21 23:18:08 2010 +0200
+++ b/lisp/gnus/nnimap.el	Tue Sep 21 23:13:46 2010 +0000
@@ -37,6 +37,7 @@
 (require 'gnus)
 (require 'nnoo)
 (require 'netrc)
+(require 'parse-time)
 
 (nnoo-declare nnimap)
 
@@ -77,6 +78,8 @@
 likely value would be \"text/\" to automatically fetch all
 textual parts.")
 
+(defvoo nnimap-expunge nil)
+
 (defvoo nnimap-connection-alist nil)
 
 (defvoo nnimap-current-infos nil)
@@ -405,7 +408,7 @@
 	  (with-current-buffer (nnimap-buffer)
 	    (erase-buffer)
 	    (let ((group-sequence
-		   (nnimap-send-command "SELECT %S" (utf7-encode group)))
+		   (nnimap-send-command "SELECT %S" (utf7-encode group t)))
 		  (flag-sequence
 		   (nnimap-send-command "UID FETCH 1:* FLAGS")))
 	      (nnimap-wait-for-response flag-sequence)
@@ -421,20 +424,28 @@
 		(setq high (nth 3 (car marks))
 		      low (nth 4 (car marks))))
 	       ((re-search-backward "UIDNEXT \\([0-9]+\\)" nil t)
-		(setq high (string-to-number (match-string 1))
+		(setq high (1- (string-to-number (match-string 1)))
 		      low 1)))))
 	  (erase-buffer)
 	  (insert
 	   (format
-	    "211 %d %d %d %S\n"
-	    (1+ (- high low))
-	    low high group))))
-      t)))
+	    "211 %d %d %d %S\n" (1+ (- high low)) low high group)))
+	t))))
+
+(deffoo nnimap-request-create-group (group &optional server args)
+  (when (nnimap-possibly-change-group nil server)
+    (with-current-buffer (nnimap-buffer)
+      (car (nnimap-command "CREATE %S" (utf7-encode group t))))))
 
 (deffoo nnimap-request-delete-group (group &optional force server)
   (when (nnimap-possibly-change-group nil server)
     (with-current-buffer (nnimap-buffer)
-      (car (nnimap-command "DELETE %S" (utf7-encode group))))))
+      (car (nnimap-command "DELETE %S" (utf7-encode group t))))))
+
+(deffoo nnimap-request-expunge-group (group &optional server)
+  (when (nnimap-possibly-change-group group server)
+    (with-current-buffer (nnimap-buffer)
+      (car (nnimap-command "EXPUNGE")))))
 
 (defun nnimap-get-flags (spec)
   (let ((articles nil)
@@ -456,38 +467,95 @@
 
 (deffoo nnimap-request-move-article (article group server accept-form
 					     &optional last internal-move-group)
-  (when (nnimap-possibly-change-group group server)
-    ;; If the move is internal (on the same server), just do it the easy
-    ;; way.
-    (let ((message-id (message-field-value "message-id")))
-      (if internal-move-group
-	  (let ((result
-		 (with-current-buffer (nnimap-buffer)
-		   (nnimap-command "UID COPY %d %S"
-				   article
-				   (utf7-encode internal-move-group t)))))
-	    (when (car result)
+  (with-temp-buffer
+    (when (nnimap-request-article article group server (current-buffer))
+      ;; If the move is internal (on the same server), just do it the easy
+      ;; way.
+      (let ((message-id (message-field-value "message-id")))
+	(if internal-move-group
+	    (let ((result
+		   (with-current-buffer (nnimap-buffer)
+		     (nnimap-command "UID COPY %d %S"
+				     article
+				     (utf7-encode internal-move-group t)))))
+	      (when (car result)
+		(nnimap-delete-article article)
+		(cons internal-move-group
+		      (nnimap-find-article-by-message-id
+		       internal-move-group message-id))))
+	  ;; Move the article to a different method.
+	  (let ((result (eval accept-form)))
+	    (when result
 	      (nnimap-delete-article article)
-	      (cons internal-move-group
-		    (nnimap-find-article-by-message-id
-		     internal-move-group message-id))))
-	(with-temp-buffer
-	  (when (nnimap-request-article article group server (current-buffer))
-	    (let ((result (eval accept-form)))
-	      (when result
-		(nnimap-delete-article article)
-		result))))))))
+	      result)))))))
 
 (deffoo nnimap-request-expire-articles (articles group &optional server force)
   (cond
+   ((null articles)
+    nil)
    ((not (nnimap-possibly-change-group group server))
     articles)
-   (force
+   ((and force
+	 (eq nnmail-expiry-target 'delete))
     (unless (nnimap-delete-article articles)
       (message "Article marked for deletion, but not expunged."))
     nil)
    (t
-    articles)))
+    (let ((deletable-articles
+	   (if force
+	       articles
+	     (gnus-sorted-intersection
+	      articles
+	      (nnimap-find-expired-articles group)))))
+      (if (null deletable-articles)
+	  articles
+	(if (eq nnmail-expiry-target 'delete)
+	    (nnimap-delete-article deletable-articles)
+	  (setq deletable-articles
+		(nnimap-process-expiry-targets
+		 deletable-articles group server)))
+	;; Return the articles we didn't delete.
+	(gnus-sorted-complement articles deletable-articles))))))
+
+(defun nnimap-process-expiry-targets (articles group server)
+  (let ((deleted-articles nil))
+    (dolist (article articles)
+      (let ((target nnmail-expiry-target))
+	(with-temp-buffer
+	  (when (nnimap-request-article article group server (current-buffer))
+	    (message "Expiring article %s:%d" group article)
+	    (when (functionp target)
+	      (setq target (funcall target group)))
+	    (when (and target
+		       (not (eq target 'delete)))
+	      (if (or (gnus-request-group target t)
+		      (gnus-request-create-group target))
+		  (nnmail-expiry-target-group target group)
+		(setq target nil)))
+	    (when target
+	      (push article deleted-articles))))))
+    ;; Change back to the current group again.
+    (nnimap-possibly-change-group group server)
+    (setq deleted-articles (nreverse deleted-articles))
+    (nnimap-delete-article deleted-articles)
+    deleted-articles))
+
+(defun nnimap-find-expired-articles (group)
+  (let ((cutoff (nnmail-expired-article-p group nil nil)))
+    (with-current-buffer (nnimap-buffer)
+      (let ((result
+	     (nnimap-command
+	      "UID SEARCH SENTBEFORE %s"
+	      (format-time-string
+	       (format "%%d-%s-%%Y"
+		       (upcase
+			(car (rassoc (nth 4 (decode-time cutoff))
+				     parse-time-months))))
+	       cutoff))))
+	(and (car result)
+	     (delete 0 (mapcar #'string-to-number
+			       (cdr (assoc "SEARCH" (cdr result))))))))))
+
 
 (defun nnimap-find-article-by-message-id (group message-id)
   (when (nnimap-possibly-change-group group nil)
@@ -505,10 +573,14 @@
   (with-current-buffer (nnimap-buffer)
     (nnimap-command "UID STORE %s +FLAGS.SILENT (\\Deleted)"
 		    (nnimap-article-ranges articles))
-    (when (member "UIDPLUS" (nnimap-capabilities nnimap-object))
-      (nnimap-send-command "UID EXPUNGE %s"
-			   (nnimap-article-ranges articles))
-      t)))
+    (cond
+     ((member "UIDPLUS" (nnimap-capabilities nnimap-object))
+      (nnimap-command "UID EXPUNGE %s"
+		      (nnimap-article-ranges articles))
+      t)
+     (nnimap-expunge
+      (nnimap-command "EXPUNGE")
+      t))))
 
 (deffoo nnimap-request-scan (&optional group server)
   (when (and (nnimap-possibly-change-group nil server)
@@ -1040,17 +1112,19 @@
 (defun nnimap-mark-and-expunge-incoming (range)
   (when range
     (setq range (nnimap-article-ranges range))
-    (nnimap-send-command
-     "UID STORE %s +FLAGS.SILENT (\\Deleted)" range)
-    (cond
-     ;; If the server supports it, we now delete the message we have
-     ;; just copied over.
-     ((member "UIDPLUS" (nnimap-capabilities nnimap-object))
-      (nnimap-send-command "UID EXPUNGE %s" range))
-     ;; If it doesn't support UID EXPUNGE, then we only expunge if the
-     ;; user has configured it.
-     (nnimap-expunge-inbox
-      (nnimap-send-command "EXPUNGE")))))
+    (let ((sequence
+	   (nnimap-send-command
+	    "UID STORE %s +FLAGS.SILENT (\\Deleted)" range)))
+      (cond
+       ;; If the server supports it, we now delete the message we have
+       ;; just copied over.
+       ((member "UIDPLUS" (nnimap-capabilities nnimap-object))
+	(setq sequence (nnimap-send-command "UID EXPUNGE %s" range)))
+       ;; If it doesn't support UID EXPUNGE, then we only expunge if the
+       ;; user has configured it.
+       (nnimap-expunge-inbox
+	(setq sequence (nnimap-send-command "EXPUNGE"))))
+      (nnimap-wait-for-response sequence))))
 
 (defun nnimap-parse-copied-articles (sequences)
   (let (sequence copied range)