changeset 110486:1ad1adb298a3

Merge Changes made in Gnus trunk. gnus-html.el (gnus-html-get-image-data): Search also for \r\n\r\n to get the start of data. gnus-html.el: Use gnus-html-encode-url to encode URL. gnus-sum.el (gnus-update-marks): Add sanity check to not delete marks outside the active range. gnus.el: Try to keep the server/method cache unique. gnus-html.el (gnus-html-rescale-image): Use window-inside-pixel-edges rather than window-pixel-edges. gnus-html.el (gnus-html-put-image): Stop using markers. gnus-html.el (gnus-html-image-fetched): Search also for \r\n\r\n to get the start of data. nnimap.el: Expunge IMAP groups by default on article deletion. gnus-int.el (gnus-request-expire-articles): Inhibit the daemon, since this command might take a while. nnimap.el (nnimap-request-list): Set the current nnimap group to nil, since EXAMINE changes it on the server. nnmail.el, nnimap.el: Allow nnimap to just delete 'junk messages when splitting. nnimap.el (nnimap-parse-flags): Make IMAP flags parsing much faster by using `read'. nnimap.el (nnimap-make-process-buffer): Record the server name. gnus-html.el (gnus-html-image-fetched): Only cache if gnus-html-image-automatic-caching is set. gnus-html.el (gnus-html-image-fetched): Check for errors. gnus-start.el (gnus-read-active-for-groups): Only run -request-scan once per method on `g'. nnimap.el (nnimap-request-expire-articles): If nnmail-expiry-wait is immediate, then expire all articles. gnus-group.el (gnus-group-get-icon): Compute icon to return. gnus-group.el (gnus-group-icon-list): Fix bad docstring information. nnimap.el (nnimap-update-info): Fix up various off-by-one errors when syncing flags in nnimap. time-date.el (date-to-time): Speed up date-to-time. gnus-start.el (gnus-get-unread-articles): Don't have `gnus-get-unread-articles-in-group' update info. gnus-group.el: Remove gnus-group-highlight-line from the default hook list. gnus-group.el (gnus-group-highlight-line): Typo fix: beg, not start. gnus-group.el (gnus-group-insert-group-line): Pass the real group name so that it gets the right data. gnus-int.el (gnus-open-server): Add tracing for performance debugging. nnimap.el (nnimap-parse-flags): Parse the data in any order. nnimap.el (nnimap-update-info): Fix up code slightly.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Thu, 23 Sep 2010 00:30:37 +0000
parents 14057cf8379c
children d3b676998c45
files doc/misc/gnus.texi lisp/ChangeLog lisp/calendar/time-date.el lisp/gnus/ChangeLog lisp/gnus/gnus-group.el lisp/gnus/gnus-html.el lisp/gnus/gnus-int.el lisp/gnus/gnus-start.el lisp/gnus/gnus-sum.el lisp/gnus/gnus.el lisp/gnus/nnimap.el lisp/gnus/nnmail.el
diffstat 12 files changed, 426 insertions(+), 277 deletions(-) [+]
line wrap: on
line diff
--- a/doc/misc/gnus.texi	Thu Sep 23 01:14:00 2010 +0200
+++ b/doc/misc/gnus.texi	Thu Sep 23 00:30:37 2010 +0000
@@ -1996,8 +1996,7 @@
 @vindex gnus-group-update-hook
 @findex gnus-group-highlight-line
 @code{gnus-group-update-hook} is called when a group line is changed.
-It will not be called when @code{gnus-visual} is @code{nil}.  This hook
-calls @code{gnus-group-highlight-line} by default.
+It will not be called when @code{gnus-visual} is @code{nil}.
 
 
 @node Group Maneuvering
--- a/lisp/ChangeLog	Thu Sep 23 01:14:00 2010 +0200
+++ b/lisp/ChangeLog	Thu Sep 23 00:30:37 2010 +0000
@@ -1,3 +1,8 @@
+2010-09-22  Dan Christensen  <jdc@uwo.ca>
+
+	* calendar/time-date.el (date-to-time): Try using parse-time-string
+	first before using the slower timezone-make-date-arpa-standard.
+
 2010-09-22  Katsumi Yamaoka  <yamaoka@jpl.org>
 
 	* calendar/time-date.el (format-seconds): Comment fix.
--- a/lisp/calendar/time-date.el	Thu Sep 23 01:14:00 2010 +0200
+++ b/lisp/calendar/time-date.el	Thu Sep 23 00:30:37 2010 +0000
@@ -97,20 +97,20 @@
 (autoload 'timezone-make-date-arpa-standard "timezone")
 
 ;;;###autoload
+;; `parse-time-string' isn't sufficiently general or robust.  It fails
+;; to grok some of the formats that timezone does (e.g. dodgy
+;; post-2000 stuff from some Elms) and either fails or returns bogus
+;; values.  timezone-make-date-arpa-standard should help.
 (defun date-to-time (date)
   "Parse a string DATE that represents a date-time and return a time value.
 If DATE lacks timezone information, GMT is assumed."
   (condition-case ()
-      (apply 'encode-time
-	     (parse-time-string
-	      ;; `parse-time-string' isn't sufficiently general or
-	      ;; robust.  It fails to grok some of the formats that
-	      ;; timezone does (e.g. dodgy post-2000 stuff from some
-	      ;; Elms) and either fails or returns bogus values.  Lars
-	      ;; reverted this change, but that loses non-trivially
-	      ;; often for me.  -- fx
-	      (timezone-make-date-arpa-standard date)))
-    (error (error "Invalid date: %s" date))))
+      (apply 'encode-time (parse-time-string date))
+    (error (condition-case ()
+	       (apply 'encode-time
+		      (parse-time-string
+		       (timezone-make-date-arpa-standard date)))
+	     (error (error "Invalid date: %s" date))))))
 
 ;; Bit of a mess.  Emacs has float-time since at least 21.1.
 ;; This file is synced to Gnus, and XEmacs packages may have been written
--- a/lisp/gnus/ChangeLog	Thu Sep 23 01:14:00 2010 +0200
+++ b/lisp/gnus/ChangeLog	Thu Sep 23 00:30:37 2010 +0000
@@ -1,9 +1,112 @@
+2010-09-22  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* nnimap.el (nnimap-parse-flags): Parse the data in any order.
+	(nnimap-update-info): Fix up code slightly.
+
+	* gnus-int.el (gnus-open-server): Add tracing for performance
+	debugging.
+
+	* gnus-group.el (gnus-group-highlight-line): Typo fix: beg, not start.
+	(gnus-group-insert-group-line): Pass the real group name so that it
+	gets the right data.
+
+	* gnus-start.el (gnus-get-unread-articles): Don't have
+	`gnus-get-unread-articles-in-group' update info, since that can be
+	really slow and doesn't seem to be needed?
+
+2010-09-22  Dan Christensen  <jdc@uwo.ca>
+
+	* time-date.el (date-to-time): Try using parse-time-string first before
+	using the slower timezone-make-date-arpa-standard.
+
+2010-09-22  Julien Danjou  <julien@danjou.info>
+
+	* gnus-group.el (gnus-group-insert-group-line): Call
+	gnus-group-highlight-line.
+	(gnus-group-update-hook): Remove gnus-group-highlight-line from the
+	default hook list.
+	(gnus-group-update-eval-form): Add new function.
+	(gnus-group-highlight-line): Use gnus-group-update-eval-form.
+	(gnus-group-get-icon): Use gnus-group-update-eval-form.
+
+2010-09-22  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* nnimap.el (nnimap-request-expire-articles): If nnmail-expiry-wait is
+	immediate, then expire all articles.
+	(nnimap-update-info): Fix off-by-one errors.
+	(nnimap-flags-to-marks): Would return no marks lists for group with no
+	flags.  Instead return the other data.
+
+2010-09-22  Julien Danjou  <julien@danjou.info>
+
+	* gnus-group.el (gnus-group-get-icon): Renamed gnus-group-add-icon that
+	Only return an icon.
+	(gnus-group-insert-group-line): Compute icon to return.
+
+	* gnus-html.el (gnus-html-image-automatic-caching): Add custom
+	variable.
+	(gnus-html-image-fetched): Only cache if
+	gnus-html-image-automatic-caching is set.
+	(gnus-html-image-fetched): Check for errors.
+
+2010-09-22  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* gnus-start.el (gnus-read-active-for-groups): Only run -request-scan
+	once per method on `g'.  This ensures that backends like nnfolder don't
+	open all their folders.
+
+	* nnimap.el (nnimap-split-incoming-mail): Delete 'junk.
+	(nnimap-request-list): Nix out group in the correct buffer.
+	(nnimap-parse-flags): Implement by using `read' instead of
+	hand-parsing.
+	(nnimap-flags-to-marks): Pass on permanent-flags.
+	(nnimap-make-process-buffer): Record the server name.
+	(nnimap-parse-flags): Fix typo.
+	(nnimap-request-scan): Run split on the server in general, not just a
+	single group.
+
+	* nnmail.el (nnmail-split-incoming): Take an optional junk-func
+	parameter, and propagate this downwards.
+
+	* nnimap.el (nnimap-request-list): Set the current nnimap group to nil,
+	since EXAMINE changes it on the server.
+
+	* gnus-int.el (gnus-request-expire-articles): Inhibit the daemon, since
+	this command might take a while.
+
+2010-09-22  Julien Danjou  <julien@danjou.info>
+
+	* gnus-html.el (gnus-html-rescale-image): Use window-inside-pixel-edges
+	rather than window-pixel-edges.
+	(gnus-html-put-image): Stop using markers. They are harmful if you have
+	2 images side-by-side, they can't be properly update on text deletion.
+	Using text-property is safer here.
+	(gnus-html-image-fetched): Search also for \r\n\r\n to get the start of
+	data.
+
+2010-09-22  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* nnimap.el (nnimap-expunge-inbox): Removed.
+	(nnimap-mark-and-expunge-incoming): Use nnimap-expunge instead.
+	(nnimap-expunge): Flip default to t.
+
+	* gnus.el (gnus-method-to-server): Don't push things to the cache
+	unless it's unique.
+	(gnus-server-to-method): Ditto.
+
 2010-09-22  Teodor Zlatanov  <tzz@lifelogs.com>
 
 	* nnimap.el (nnimap-delete-article): Tell user if expunge won't happen.
 
 2010-09-22  Julien Danjou  <julien@danjou.info>
 
+	* gnus-html.el (gnus-html-get-image-data): Search also for \r\n\r\n to
+	get the start of data.
+	(gnus-html-encode-url): Add this function to encode special chars in
+	URL.
+	(gnus-html-wash-images): Use gnus-html-encode-url to encode URL.
+	(gnus-html-prefetch-images): Use gnus-html-encode-url to encode URL.
+
 	* gnus-group.el (gnus-group-update-hook): Call gnus-group-add-icon by
 	default.
 	(gnus-group-add-icon): Move to gnus-group.el, and rewrite so it works.
@@ -19,6 +122,19 @@
 	* nnir.el (nnir-run-find-grep)
 	* pop3.el (pop3-list): Use 3rd arg of split-string.
 
+2010-09-21  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* gnus-sum.el (gnus-update-marks): Add sanity check to not delete marks
+	outside the active range.  Suggested by Dan Christensen.
+
+	* gnus-start.el (gnus-get-unread-articles): Get the extended method
+	slightly later to avoid double-getting it.
+
+	* nnml.el (nnml-generate-nov-file): Fix variable name clobbering from
+	previous patch.
+
+	* gnus-sum.el (gnus-adjust-marked-articles): Fix another typo.
+
 2010-09-21  Adam Sjøgren  <asjo@koldfront.dk>
 
 	* gnus-sum.el (gnus-adjust-marked-articles): Fix typo.
@@ -103,6 +219,9 @@
 
 2010-09-20  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
+	* gnus-group.el (gnus-group-line-format-alist): Have the ?U (unseen)
+	spec inser "*" if the group isn't active instead of 0.
+
 	* nnimap.el (nnimap-request-group): Don't select the imap buffer before
 	opening the server.
 	(nnimap-request-delete-group): Implement group deletion.
@@ -369,7 +488,7 @@
 
 	* dgnushack.el: Define netrc-credentials.
 
-2010-09-17  Julien Danjou  <julien@danjou.info>  (tiny fix)
+2010-09-17  Julien Danjou  <julien@danjou.info>
 
 	* mm-decode.el (mm-text-html-renderer): Document gnus-article-html.
 
@@ -439,6 +558,9 @@
 
 2010-09-14  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
+	* gnus-registry.el (gnus-registry-install-shortcuts): The second
+	parameter to unintern is mandatory-ish in Emacs 24.
+
 	* gnus-html.el (gnus-html-schedule-image-fetching)
 	(gnus-html-prefetch-images): Check for curl before using it.
 
--- a/lisp/gnus/gnus-group.el	Thu Sep 23 01:14:00 2010 +0200
+++ b/lisp/gnus/gnus-group.el	Thu Sep 23 00:30:37 2010 +0000
@@ -292,14 +292,8 @@
   :group 'gnus-exit
   :type 'hook)
 
-(defcustom gnus-group-update-hook '(gnus-group-highlight-line gnus-group-add-icon)
-  "Hook called when a group line is changed.
-The hook will not be called if `gnus-visual' is nil.
-
-The default functions `gnus-group-highlight-line' will highlight
-the line according to the `gnus-group-highlight' variable, and
-`gnus-group-add-icon' will add an icon according to
-`gnus-group-icon-list'"
+(defcustom gnus-group-update-hook nil
+  "Hook called when a group line is changed."
   :group 'gnus-group-visual
   :type 'hook)
 
@@ -429,7 +423,6 @@
 unread: The number of unread articles in the group.
 method: The select method used.
 mailp: Whether it's a mail group or not.
-newsp: Whether it's a news group or not
 level: The level of the group.
 score: The score of the group.
 ticked: The number of ticked articles."
@@ -1579,7 +1572,7 @@
 	      ?m ? ))
 	 (gnus-tmp-moderated-string
 	  (if (eq gnus-tmp-moderated ?m) "(m)" ""))
-         (gnus-tmp-group-icon (propertize " " 'gnus-group-icon t))
+         (gnus-tmp-group-icon (gnus-group-get-icon gnus-tmp-qualified-group))
 	 (gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
 	 (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
 	 (gnus-tmp-news-method-string
@@ -1626,108 +1619,85 @@
 			      'gnus-tool-bar-update))
     (forward-line -1)
     (when (inline (gnus-visual-p 'group-highlight 'highlight))
-      (gnus-run-hooks 'gnus-group-update-hook))
+      (gnus-group-highlight-line gnus-tmp-group beg end))
+    (gnus-run-hooks 'gnus-group-update-hook)
     (forward-line)
     ;; Allow XEmacs to remove front-sticky text properties.
     (gnus-group-remove-excess-properties)))
 
-(defun gnus-group-highlight-line ()
-  "Highlight the current line according to `gnus-group-highlight'."
-  (let* ((list gnus-group-highlight)
-	 (p (point))
-	 (end (point-at-eol))
-	 ;; now find out where the line starts and leave point there.
-	 (beg (progn (beginning-of-line) (point)))
-	 (group (gnus-group-group-name))
-	 (entry (gnus-group-entry group))
-	 (unread (if (numberp (car entry)) (car entry) 0))
-	 (active (gnus-active group))
-	 (total (if active (1+ (- (cdr active) (car active))) 0))
-	 (info (nth 2 entry))
-	 (method (inline (gnus-server-get-method group (gnus-info-method info))))
-	 (marked (gnus-info-marks info))
-	 (mailp (apply 'append
-		       (mapcar
-			(lambda (x)
-			  (memq x (assoc (symbol-name
-					  (car (or method gnus-select-method)))
-					 gnus-valid-select-methods)))
-			'(mail post-mail))))
-	 (level (or (gnus-info-level info) gnus-level-killed))
-	 (score (or (gnus-info-score info) 0))
-	 (ticked (gnus-range-length (cdr (assq 'tick marked))))
-	 (group-age (gnus-group-timestamp-delta group))
-	 (inhibit-read-only t))
-    ;; FIXME: http://thread.gmane.org/gmane.emacs.gnus.general/65451/focus=65465
-    ;; ======================================================================
-    ;; From: Richard Stallman
-    ;; Subject: Re: Rewriting gnus-group-highlight-line (was: [...])
-    ;; Cc: ding@gnus.org
-    ;; Date: Sat, 27 Oct 2007 19:41:20 -0400
-    ;; Message-ID: <E1IlvHM-0006TS-7t@fencepost.gnu.org>
-    ;;
-    ;; [...]
-    ;; The kludge is that the alist elements contain expressions that refer
-    ;; to local variables with short names.  Perhaps write your own tiny
-    ;; evaluator that handles just `and', `or', and numeric comparisons
-    ;; and just a few specific variables.
-    ;; ======================================================================
-    ;;
-    ;; Similar for other evaluated variables.  Grep for risky-local-variable
-    ;; to find them!  -- rsteib
-    ;;
-    ;; Eval the cars of the lists until we find a match.
-    (while (and list
-		(not (eval (caar list))))
-      (setq list (cdr list)))
-    (let ((face (cdar list)))
-      (unless (eq face (get-text-property beg 'face))
-	(gnus-put-text-property-excluding-characters-with-faces
-	 beg end 'face
-	 (setq face (if (boundp face) (symbol-value face) face)))
-	(gnus-extent-start-open beg)))
-    (goto-char p)))
-
-(defun gnus-group-add-icon ()
-  "Add an icon to the current line according to `gnus-group-icon-list'."
-  (save-excursion
-    (let* ((end (line-end-position))
-           ;; now find out where the line starts and leave point there.
-           (beg (line-beginning-position)))
-      (save-restriction
-        (narrow-to-region beg end)
-        (goto-char beg)
-        (let ((mystart (text-property-any beg end 'gnus-group-icon t)))
-          (when mystart
-            (let* ((group (gnus-group-group-name))
-                   (entry (gnus-group-entry group))
-                   (unread (if (numberp (car entry)) (car entry) 0))
-                   (active (gnus-active group))
-                   (total (if active (1+ (- (cdr active) (car active))) 0))
-                   (info (nth 2 entry))
-                   (method (gnus-server-get-method group (gnus-info-method info)))
-                   (marked (gnus-info-marks info))
-                   (mailp (memq 'mail (assoc (symbol-name
-                                              (car (or method gnus-select-method)))
-                                             gnus-valid-select-methods)))
-                   (level (or (gnus-info-level info) gnus-level-killed))
-                   (score (or (gnus-info-score info) 0))
-                   (ticked (gnus-range-length (cdr (assq 'tick marked))))
-                   (group-age (gnus-group-timestamp-delta group))
-                   (inhibit-read-only t)
-                   (list gnus-group-icon-list)
-                   (myend (next-single-property-change
-                           mystart 'gnus-group-icon)))
-              (while (and list
-                          (not (eval (caar list))))
-                (setq list (cdr list)))
-              (when list
-                (put-text-property
-                 mystart myend
-                 'display
-                 (append
-                  (gnus-create-image (expand-file-name (cdar list)))
-                  '(:ascent center)))))))))))
+(defun gnus-group-update-eval-form (group list)
+  "Eval `car' of each element of LIST, and return the first that return t.
+Some value are bound so the form can use them."
+  (when list
+    (let* ((entry (gnus-group-entry group))
+           (unread (if (numberp (car entry)) (car entry) 0))
+           (active (gnus-active group))
+           (total (if active (1+ (- (cdr active) (car active))) 0))
+           (info (nth 2 entry))
+           (method (inline (gnus-server-get-method group (gnus-info-method info))))
+           (marked (gnus-info-marks info))
+           (mailp (apply 'append
+                         (mapcar
+                          (lambda (x)
+                            (memq x (assoc (symbol-name
+                                            (car (or method gnus-select-method)))
+                                           gnus-valid-select-methods)))
+                          '(mail post-mail))))
+           (level (or (gnus-info-level info) gnus-level-killed))
+           (score (or (gnus-info-score info) 0))
+           (ticked (gnus-range-length (cdr (assq 'tick marked))))
+           (group-age (gnus-group-timestamp-delta group)))
+      ;; FIXME: http://thread.gmane.org/gmane.emacs.gnus.general/65451/focus=65465
+      ;; ======================================================================
+      ;; From: Richard Stallman
+      ;; Subject: Re: Rewriting gnus-group-highlight-line (was: [...])
+      ;; Cc: ding@gnus.org
+      ;; Date: Sat, 27 Oct 2007 19:41:20 -0400
+      ;; Message-ID: <E1IlvHM-0006TS-7t@fencepost.gnu.org>
+      ;;
+      ;; [...]
+      ;; The kludge is that the alist elements contain expressions that refer
+      ;; to local variables with short names.  Perhaps write your own tiny
+      ;; evaluator that handles just `and', `or', and numeric comparisons
+      ;; and just a few specific variables.
+      ;; ======================================================================
+      ;;
+      ;; Similar for other evaluated variables.  Grep for risky-local-variable
+      ;; to find them!  -- rsteib
+      ;;
+      ;; Eval the cars of the lists until we find a match.
+      (while (and list
+                  (not (eval (caar list))))
+        (setq list (cdr list)))
+      list)))
+
+(defun gnus-group-highlight-line (group beg end)
+  "Highlight the current line according to `gnus-group-highlight'.
+GROUP is current group, and the line to highlight starts at START
+and ends at END."
+  (let ((face (cdar (gnus-group-update-eval-form
+                      group
+                      gnus-group-highlight))))
+    (unless (eq face (get-text-property beg 'face))
+      (let ((inhibit-read-only t))
+        (gnus-put-text-property-excluding-characters-with-faces
+         beg end 'face
+         (if (boundp face) (symbol-value face) face)))
+      (gnus-extent-start-open beg))))
+
+(defun gnus-group-get-icon (group)
+  "Return an icon for GROUP according to `gnus-group-icon-list'."
+  (if gnus-group-icon-list
+      (let ((image-path
+             (cdar (gnus-group-update-eval-form group gnus-group-icon-list))))
+        (if image-path
+            (propertize " "
+                        'display
+                        (append
+                         (gnus-create-image (expand-file-name image-path))
+                         '(:ascent center)))
+          " "))
+    " "))
 
 (defun gnus-group-update-group (group &optional visible-only)
   "Update all lines where GROUP appear.
--- a/lisp/gnus/gnus-html.el	Thu Sep 23 01:14:00 2010 +0200
+++ b/lisp/gnus/gnus-html.el	Thu Sep 23 00:30:37 2010 +0000
@@ -36,13 +36,20 @@
 (require 'url)
 (require 'url-cache)
 (require 'xml)
+(require 'browse-url)
 
 (defcustom gnus-html-image-cache-ttl (days-to-time 7)
-  "Time in seconds used to cache the image on disk."
+  "Time used to determine if we should use images from the cache."
   :version "24.1"
   :group 'gnus-art
   :type 'integer)
 
+(defcustom gnus-html-image-automatic-caching t
+  "Whether automatically cache retrieve images."
+  :version "24.1"
+  :group 'gnus-art
+  :type 'boolean)
+
 (defcustom gnus-html-frame-width 70
   "What width to use when rendering HTML."
   :version "24.1"
@@ -81,6 +88,10 @@
     (define-key map [tab] 'widget-forward)
     map))
 
+(defun gnus-html-encode-url (url)
+  "Encode URL."
+  (browse-url-url-encode-chars url "[)$ ]"))
+
 (defun gnus-html-cache-expired (url ttl)
   "Check if URL is cached for more than TTL."
   (cond (url-standalone-mode
@@ -155,7 +166,7 @@
 	(delete-region (match-beginning 0) (match-end 0)))
       (setq end (point))
       (when (string-match "src=\"\\([^\"]+\\)" parameters)
-	(setq url (match-string 1 parameters))
+	(setq url (gnus-html-encode-url (match-string 1 parameters)))
 	(gnus-message 8 "gnus-html-wash-tags: fetching image URL %s" url)
 	(if (string-match "^cid:\\(.*\\)" url)
 	    ;; URLs with cid: have their content stashed in other
@@ -177,6 +188,7 @@
           (let ((alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)"
                                               parameters)
                             (xml-substitute-special (match-string 2 parameters)))))
+            (gnus-put-text-property start end 'gnus-image-url url)
             (if (gnus-html-image-url-blocked-p
                  url
                  (if (buffer-live-p gnus-summary-buffer)
@@ -191,13 +203,9 @@
                    :keymap gnus-html-image-map
                    :button-keymap gnus-html-image-map)
                   (let ((overlay (gnus-make-overlay start end))
-                        (spec (list url
-                                    (set-marker (make-marker) start)
-                                    (set-marker (make-marker) end)
-                                    alt-text)))
+                        (spec (list url alt-text)))
                     (gnus-overlay-put overlay 'local-map gnus-html-image-map)
                     (gnus-overlay-put overlay 'gnus-image spec)
-                    (gnus-put-text-property start end 'gnus-image-url url)
                     (gnus-put-text-property
                      start end
                      'gnus-image spec)))
@@ -224,13 +232,9 @@
       ;; asynchronously.
       (gnus-html-schedule-image-fetching
        (current-buffer)
-       (list url
-             (set-marker (make-marker) start)
-             (set-marker (make-marker) end)
-             alt-text))
+       (list url alt-text))
     ;; It's already cached, so just insert it.
-    (gnus-html-put-image (gnus-html-get-image-data url)
-                         start end url alt-text)))
+    (gnus-html-put-image (gnus-html-get-image-data url) url alt-text)))
 
 (defun gnus-html-wash-tags ()
   (let (tag parameters string start end images url)
@@ -347,22 +351,17 @@
                   (list buffer image))))
 
 (defun gnus-html-image-fetched (status buffer image)
-  (url-store-in-cache (current-buffer))
-  (when (and (search-forward "\n\n" nil t)
-             (buffer-live-p buffer)
-             ;; If the `image' has no marker, do not replace anything
-             (cadr image)
-             ;; If the position of the marker is 1, then that
-             ;; means that the text it was in has been deleted;
-             ;; i.e., that the user has selected a different
-             ;; article before the image arrived.
-             (not (= (marker-position (cadr image))
-                     (with-current-buffer buffer
-                       (point-min)))))
-    (let ((data (buffer-substring (point) (point-max))))
-      (with-current-buffer buffer
-        (let ((inhibit-read-only t))
-          (gnus-html-put-image data (cadr image) (caddr image) (car image) (cadddr image))))))
+  "Callback function called when image has been fetched."
+  (unless (plist-get status :error)
+    (when gnus-html-image-automatic-caching
+      (url-store-in-cache (current-buffer)))
+    (when (and (or (search-forward "\n\n" nil t)
+                   (search-forward "\r\n\r\n" nil t))
+               (buffer-live-p buffer))
+      (let ((data (buffer-substring (point) (point-max))))
+        (with-current-buffer buffer
+          (let ((inhibit-read-only t))
+            (gnus-html-put-image data (car image) (cadr image)))))))
   (kill-buffer (current-buffer)))
 
 (defun gnus-html-get-image-data (url)
@@ -371,54 +370,61 @@
   (with-temp-buffer
     (mm-disable-multibyte)
     (url-cache-extract (url-cache-create-filename url))
-    (when (search-forward "\n\n" nil t)
+    (when (or (search-forward "\n\n" nil t)
+              (search-forward "\r\n\r\n" nil t))
       (buffer-substring (point) (point-max)))))
 
-(defun gnus-html-put-image (data start end &optional url alt-text)
+(defun gnus-html-put-image (data url &optional alt-text)
   (when (gnus-graphic-display-p)
-    (let* ((image (ignore-errors
-                    (gnus-create-image data nil t)))
-           (size (and image
-                      (if (featurep 'xemacs)
-                          (cons (glyph-width image) (glyph-height image))
-                        (image-size image t)))))
-      (save-excursion
-	(goto-char start)
-        (let ((alt-text (or alt-text (buffer-substring-no-properties start end))))
-          (if (and image
-                   ;; Kludge to avoid displaying 30x30 gif images, which
-                   ;; seems to be a signal of a broken image.
-                   (not (and (if (featurep 'xemacs)
-                                 (glyphp image)
-                               (listp image))
-                             (eq (if (featurep 'xemacs)
-                                     (let ((d (cdadar (specifier-spec-list
-                                                       (glyph-image image)))))
-                                       (and (vectorp d)
-                                            (aref d 0)))
-                                   (plist-get (cdr image) :type))
-                                 'gif)
-                             (= (car size) 30)
-                             (= (cdr size) 30))))
-              ;; Good image, add it!
-              (let ((image (gnus-html-rescale-image image data size)))
-                (delete-region start end)
-                (gnus-put-image image alt-text 'external)
-                (gnus-put-text-property start (point) 'help-echo alt-text)
-                (gnus-overlay-put (gnus-make-overlay start (point)) 'local-map
-                                  gnus-html-displayed-image-map)
-                (gnus-put-text-property start (point) 'gnus-alt-text alt-text)
-                (when url
-                  (gnus-put-text-property start (point) 'gnus-image-url url))
-                (gnus-add-image 'external image)
-                t)
-            ;; Bad image, try to show something else
-            (delete-region start end)
-            (when (fboundp 'find-image)
-              (setq image (find-image '((:type xpm :file "lock-broken.xpm"))))
-              (gnus-put-image image alt-text 'internal)
-              (gnus-add-image 'internal image))
-            nil))))))
+    (let* ((start (text-property-any (point-min) (point-max) 'gnus-image-url url))
+           (end (when start
+                  (next-single-property-change start 'gnus-image-url))))
+      ;; Image found?
+      (when start
+        (let* ((image
+                (ignore-errors
+                  (gnus-create-image data nil t)))
+               (size (and image
+                          (if (featurep 'xemacs)
+                              (cons (glyph-width image) (glyph-height image))
+                            (image-size image t)))))
+          (save-excursion
+            (goto-char start)
+            (let ((alt-text (or alt-text (buffer-substring-no-properties start end))))
+              (if (and image
+                       ;; Kludge to avoid displaying 30x30 gif images, which
+                       ;; seems to be a signal of a broken image.
+                       (not (and (if (featurep 'xemacs)
+                                     (glyphp image)
+                                   (listp image))
+                                 (eq (if (featurep 'xemacs)
+                                         (let ((d (cdadar (specifier-spec-list
+                                                           (glyph-image image)))))
+                                           (and (vectorp d)
+                                                (aref d 0)))
+                                       (plist-get (cdr image) :type))
+                                     'gif)
+                                 (= (car size) 30)
+                                 (= (cdr size) 30))))
+                  ;; Good image, add it!
+                  (let ((image (gnus-html-rescale-image image data size)))
+                    (delete-region start end)
+                    (gnus-put-image image alt-text 'external)
+                    (gnus-put-text-property start (point) 'help-echo alt-text)
+                    (gnus-overlay-put (gnus-make-overlay start (point)) 'local-map
+                                      gnus-html-displayed-image-map)
+                    (gnus-put-text-property start (point) 'gnus-alt-text alt-text)
+                    (when url
+                      (gnus-put-text-property start (point) 'gnus-image-url url))
+                    (gnus-add-image 'external image)
+                    t)
+                ;; Bad image, try to show something else
+                (when (fboundp 'find-image)
+                  (delete-region start end)
+                  (setq image (find-image '((:type xpm :file "lock-broken.xpm"))))
+                  (gnus-put-image image alt-text 'internal)
+                  (gnus-add-image 'internal image))
+                nil))))))))
 
 (defun gnus-html-rescale-image (image data size)
   (if (or (not (fboundp 'imagemagick-types))
@@ -426,7 +432,7 @@
       image
     (let* ((width (car size))
 	   (height (cdr size))
-	   (edges (window-pixel-edges (get-buffer-window (current-buffer))))
+	   (edges (window-inside-pixel-edges (get-buffer-window (current-buffer))))
 	   (window-width (truncate (* gnus-max-image-proportion
 				      (- (nth 2 edges) (nth 0 edges)))))
 	   (window-height (truncate (* gnus-max-image-proportion
@@ -472,7 +478,7 @@
                             gnus-blocked-images)))
       (save-match-data
 	(while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t)
-	  (let ((url (match-string 1)))
+	  (let ((url (gnus-html-encode-url (match-string 1))))
 	    (unless (gnus-html-image-url-blocked-p url blocked-images)
               (when (gnus-html-cache-expired url gnus-html-image-cache-ttl)
                 (gnus-html-schedule-image-fetching nil
--- a/lisp/gnus/gnus-int.el	Thu Sep 23 01:14:00 2010 +0200
+++ b/lisp/gnus/gnus-int.el	Thu Sep 23 00:30:37 2010 +0000
@@ -226,10 +226,18 @@
   (eq (nth 1 (assoc method gnus-opened-servers))
       'denied))
 
+(defvar gnus-backend-trace t)
+
 (defun gnus-open-server (gnus-command-method)
   "Open a connection to GNUS-COMMAND-METHOD."
   (when (stringp gnus-command-method)
     (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+  (when gnus-backend-trace
+    (with-current-buffer (get-buffer-create "*gnus trace*")
+      (buffer-disable-undo)
+      (goto-char (point-max))
+      (insert (format-time-string "%H:%M:%S")
+	      (format " %S\n" gnus-command-method))))
   (let ((elem (assoc gnus-command-method gnus-opened-servers))
 	(server (gnus-method-to-server-name gnus-command-method)))
     ;; If this method was previously denied, we just return nil.
@@ -601,6 +609,7 @@
 
 (defun gnus-request-expire-articles (articles group &optional force)
   (let* ((gnus-command-method (gnus-find-method-for-group group))
+	 (gnus-inhibit-demon t)
 	 (not-deleted
 	  (funcall
 	   (gnus-get-function gnus-command-method 'request-expire-articles)
--- a/lisp/gnus/gnus-start.el	Thu Sep 23 01:14:00 2010 +0200
+++ b/lisp/gnus/gnus-start.el	Thu Sep 23 00:30:37 2010 +0000
@@ -1757,8 +1757,7 @@
 	  (when (gnus-check-backend-function
 		 'retrieve-group-data-early (car method))
 	    (when (gnus-check-backend-function 'request-scan (car method))
-	      (dolist (info infos)
-		(gnus-request-scan (gnus-info-group info) method)))
+	      (gnus-request-scan nil method))
 	    (setcar (nthcdr 3 elem)
 		    (gnus-retrieve-group-data-early method infos))))))
 
@@ -1770,8 +1769,7 @@
 	  (gnus-read-active-for-groups method infos early-data)
 	  (dolist (info infos)
 	    (inline (gnus-get-unread-articles-in-group
-		     info (gnus-active (gnus-info-group info))
-		     t))))))
+		     info (gnus-active (gnus-info-group info))))))))
     (gnus-message 6 "Checking new news...done")))
 
 (defun gnus-method-rank (type method)
@@ -1806,8 +1804,7 @@
       (gnus-agent-save-active method))
      ((gnus-check-backend-function 'retrieve-groups (car method))
       (when (gnus-check-backend-function 'request-scan (car method))
-	(dolist (info infos)
-	  (gnus-request-scan (gnus-info-group info) method)))
+	(gnus-request-scan nil method))
       (let (groups)
 	(gnus-read-active-file-2
 	 (dolist (info infos (nreverse groups))
@@ -2055,10 +2052,7 @@
 			  (gnus-online method))
 		     (not gnus-agent))
 		 (gnus-check-backend-function 'request-scan (car method)))
-	(if infos
-	    (dolist (info infos)
-	      (gnus-request-scan (gnus-info-group info) method))
-	  (gnus-request-scan nil method)))
+	(gnus-request-scan nil method))
       (cond
        ((and (eq gnus-read-active-file 'some)
 	     (gnus-check-backend-function 'retrieve-groups (car method))
--- a/lisp/gnus/gnus-sum.el	Thu Sep 23 01:14:00 2010 +0200
+++ b/lisp/gnus/gnus-sum.el	Thu Sep 23 00:30:37 2010 +0000
@@ -5976,6 +5976,10 @@
 	    (when add
 	      (push (list add 'add (list (cdr type))) delta-marks))
 	    (when del
+	      ;; Don't delete marks from outside the active range.  This
+	      ;; shouldn't happen, but is a sanity check.
+	      (setq del (gnus-sorted-range-intersection
+			 (gnus-active gnus-newsgroup-name) del))
 	      (push (list del 'del (list (cdr type))) delta-marks))))
 
 	(when list
--- a/lisp/gnus/gnus.el	Thu Sep 23 01:14:00 2010 +0200
+++ b/lisp/gnus/gnus.el	Thu Sep 23 00:30:37 2010 +0000
@@ -3566,7 +3566,7 @@
 				   (nth 1 method))))
       method)))
 
-(defsubst gnus-method-to-server (method &optional nocache)
+(defsubst gnus-method-to-server (method &optional nocache no-enter-cache)
   (catch 'server-name
     (setq method (or method gnus-select-method))
 
@@ -3592,7 +3592,9 @@
 		     (format "%s" (car method))
 		   (format "%s:%s" (car method) (cadr method))))
 	   (name-method (cons name method)))
-      (unless (member name-method gnus-server-method-cache)
+      (when (and (not (member name-method gnus-server-method-cache))
+		 (not no-enter-cache)
+		 (not (assoc (car name-method) gnus-server-method-cache)))
 	(push name-method gnus-server-method-cache))
       name)))
 
@@ -3634,11 +3636,13 @@
 		(while alist
 		  (setq method (gnus-info-method (pop alist)))
 		  (when (and (not (stringp method))
-			     (equal server (gnus-method-to-server method)))
+			     (equal server
+				    (gnus-method-to-server method nil t)))
 		    (setq match method
 			  alist nil)))
 		match))))
-	(when result
+	(when (and result
+		   (not (assoc server gnus-server-method-cache)))
 	  (push (cons server result) gnus-server-method-cache))
 	result)))
 
--- a/lisp/gnus/nnimap.el	Thu Sep 23 01:14:00 2010 +0200
+++ b/lisp/gnus/nnimap.el	Thu Sep 23 00:30:37 2010 +0000
@@ -62,11 +62,6 @@
 (defvoo nnimap-inbox nil
   "The mail box where incoming mail arrives and should be split out of.")
 
-(defvoo nnimap-expunge-inbox nil
-  "If non-nil, expunge the inbox after fetching mail.
-This is always done if the server supports UID EXPUNGE, but it's
-not done by default on servers that doesn't support that command.")
-
 (defvoo nnimap-authenticator nil
   "How nnimap authenticate itself to the server.
 Possible choices are nil (use default methods) or `anonymous'.")
@@ -78,7 +73,11 @@
 likely value would be \"text/\" to automatically fetch all
 textual parts.")
 
-(defvoo nnimap-expunge nil)
+(defvoo nnimap-expunge t
+  "If non-nil, expunge articles after deleting them.
+This is always done if the server supports UID EXPUNGE, but it's
+not done by default on servers that doesn't support that command.")
+
 
 (defvoo nnimap-connection-alist nil)
 
@@ -92,14 +91,14 @@
   "Internal variable with default value for `nnimap-split-download-body'.")
 
 (defstruct nnimap
-  group process commands capabilities select-result newlinep)
+  group process commands capabilities select-result newlinep server)
 
 (defvar nnimap-object nil)
 
 (defvar nnimap-mark-alist
-  '((read "\\Seen")
-    (tick "\\Flagged")
-    (reply "\\Answered")
+  '((read "\\Seen" %Seen)
+    (tick "\\Flagged" %Flagged)
+    (reply "\\Answered" %Answered)
     (expire "gnus-expire")
     (dormant "gnus-dormant")
     (score "gnus-score")
@@ -213,7 +212,8 @@
     (buffer-disable-undo)
     (gnus-add-buffer)
     (set (make-local-variable 'after-change-functions) nil)
-    (set (make-local-variable 'nnimap-object) (make-nnimap))
+    (set (make-local-variable 'nnimap-object)
+	 (make-nnimap :server (nnoo-current-server 'nnimap)))
     (push (list buffer (current-buffer)) nnimap-connection-alist)
     (current-buffer)))
 
@@ -421,8 +421,9 @@
 	      (goto-char (point-max))
 	      (cond
 	       (marks
-		(setq high (nth 3 (car marks))
-		      low (nth 4 (car marks))))
+		(let ((uidnext (nth 5 (car marks))))
+		  (setq high (or (nth 3 (car marks)) (1- uidnext))
+			low (or (nth 4 (car marks)) uidnext))))
 	       ((re-search-backward "UIDNEXT \\([0-9]+\\)" nil t)
 		(setq high (1- (string-to-number (match-string 1)))
 		      low 1)))))
@@ -502,7 +503,8 @@
     nil)
    (t
     (let ((deletable-articles
-	   (if force
+	   (if (or force
+		   (eq nnmail-expiry-wait 'immediate))
 	       articles
 	     (gnus-sorted-intersection
 	      articles
@@ -587,9 +589,9 @@
 
 (deffoo nnimap-request-scan (&optional group server)
   (when (and (nnimap-possibly-change-group nil server)
-	     (equal group nnimap-inbox)
 	     nnimap-inbox
 	     nnimap-split-methods)
+    (message "nnimap %s splitting mail..." server)
     (nnimap-split-incoming-mail)))
 
 (defun nnimap-marks-to-flags (marks)
@@ -667,6 +669,7 @@
 	  sequences responses)
       (when groups
 	(with-current-buffer (nnimap-buffer)
+	  (setf (nnimap-group nnimap-object) nil)
 	  (dolist (group groups)
 	    (push (list (nnimap-send-command "EXAMINE %S" (utf7-encode group t))
 			group)
@@ -716,6 +719,7 @@
 		groups))
 	;; Then request the data.
 	(erase-buffer)
+	(setf (nnimap-group nnimap-object) nil)
 	(dolist (elem groups)
 	  (if (and qresyncp
 		   (nth 2 elem))
@@ -773,7 +777,8 @@
 
 (defun nnimap-update-info (info marks)
   (when marks
-    (destructuring-bind (existing flags high low uidnext start-article) marks
+    (destructuring-bind (existing flags high low uidnext start-article
+				  permanent-flags) marks
       (let ((group (gnus-info-group info))
 	    (completep (and start-article
 			    (= start-article 1))))
@@ -784,16 +789,18 @@
 			     (if high
 				 (cons low high)
 			       ;; No articles in this group.
-			       (cons (1- uidnext) uidnext)))
-	  (setcdr (gnus-active group) high))
+			       (cons uidnext (1- uidnext))))
+	  (setcdr (gnus-active group) (or high (1- uidnext))))
+	(unless high
+	  (setq high (1- uidnext)))
 	;; Then update the list of read articles.
 	(let* ((unread
 		(gnus-compress-sequence
 		 (gnus-set-difference
 		  (gnus-set-difference
 		   existing
-		   (cdr (assoc "\\Seen" flags)))
-		  (cdr (assoc "\\Flagged" flags)))))
+		   (cdr (assoc '%Seen flags)))
+		  (cdr (assoc '%Flagged flags)))))
 	       (read (gnus-range-difference
 		      (cons start-article high) unread)))
 	  (when (> start-article 1)
@@ -815,8 +822,10 @@
 	      (push (cons 'active (gnus-active group)) marks)))
 	  (dolist (type (cdr nnimap-mark-alist))
 	    (let ((old-marks (assoc (car type) marks))
-		  (new-marks (gnus-compress-sequence
-			      (cdr (assoc (cadr type) flags)))))
+		  (new-marks
+		   (gnus-compress-sequence
+		    (cdr (or (assoc (caddr type) flags)	    ; %Flagged
+			     (assoc (cadr type) flags)))))) ; "\Flagged"
 	      (setq marks (delq old-marks marks))
 	      (pop old-marks)
 	      (when (and old-marks
@@ -838,12 +847,13 @@
       (push (list group info active) nnimap-current-infos))))
 
 (defun nnimap-flags-to-marks (groups)
-  (let (data group totalp uidnext articles start-article mark)
+  (let (data group totalp uidnext articles start-article mark permanent-flags)
     (dolist (elem groups)
       (setq group (car elem)
-	    uidnext (cadr elem)
-	    start-article (caddr elem)
-	    articles (cdddr elem))
+	    uidnext (nth 1 elem)
+	    start-article (nth 2 elem)
+	    permanent-flags (nth 3 elem)
+	    articles (nthcdr 4 elem))
       (let ((high (caar articles))
 	    marks low existing)
 	(dolist (article articles)
@@ -853,36 +863,49 @@
 	    (setq mark (assoc flag marks))
 	    (if (not mark)
 		(push (list flag (car article)) marks)
-	      (setcdr mark (cons (car article) (cdr mark)))))
-	  (push (list group existing marks high low uidnext start-article)
-		data))))
+	      (setcdr mark (cons (car article) (cdr mark))))))
+	(push (list group existing marks high low uidnext start-article
+		    permanent-flags)
+	      data)))
     data))
 
 (defun nnimap-parse-flags (sequences)
   (goto-char (point-min))
-  (let (start end articles groups uidnext elems)
+  ;; Change \Delete etc to %Delete, so that the reader can read it.
+  (subst-char-in-region (point-min) (point-max)
+			?\\ ?% t)
+  (let (start end articles groups uidnext elems permanent-flags)
     (dolist (elem sequences)
       (destructuring-bind (group-sequence flag-sequence totalp group) elem
+	(setq start (point))
 	;; The EXAMINE was successful.
 	(when (and (search-forward (format "\n%d OK " group-sequence) nil t)
 		   (progn
 		     (forward-line 1)
-		     (setq start (point))
-		     (if (re-search-backward "UIDNEXT \\([0-9]+\\)"
-					       (or end (point-min)) t)
-			 (setq uidnext (string-to-number (match-string 1)))
-		       (setq uidnext nil))
-		     (goto-char start))
+		     (setq end (point))
+		     (goto-char start)
+		     (setq permanent-flags
+			   (and (search-forward "PERMANENTFLAGS "
+						 (or end (point-min)) t)
+				(read (current-buffer))))
+		     (goto-char start)
+		     (setq uidnext
+			   (and (search-forward "UIDNEXT "
+						 (or end (point-min)) t)
+				(read (current-buffer))))
+		     (goto-char end)
+		     (forward-line -1))
 		   ;; The UID FETCH FLAGS was successful.
 		   (search-forward (format "\n%d OK " flag-sequence) nil t))
-	  (setq end (point))
-	  (goto-char start)
-	  (while (re-search-forward "^\\* [0-9]+ FETCH (\\(.*\\))" end t)
-	    (setq elems (nnimap-parse-line (match-string 1)))
-	    (push (cons (string-to-number (cadr (member "UID" elems)))
-			(cadr (member "FLAGS" elems)))
+	  (setq start (point))
+	  (goto-char end)
+	  (while (search-forward " FETCH " start t)
+	    (setq elems (read (current-buffer)))
+	    (push (cons (cadr (memq 'UID elems))
+			(cadr (memq 'FLAGS elems)))
 		  articles))
-	  (push (nconc (list group uidnext totalp) articles) groups)
+	  (push (nconc (list group uidnext totalp permanent-flags) articles)
+		groups)
 	  (setq articles nil))))
     groups))
 
@@ -1085,32 +1108,38 @@
 	(nnmail-split-incoming (current-buffer)
 			       #'nnimap-save-mail-spec
 			       nil nil
-			       #'nnimap-dummy-active-number)
+			       #'nnimap-dummy-active-number
+			       #'nnimap-save-mail-spec)
 	(when nnimap-incoming-split-list
 	  (let ((specs (nnimap-make-split-specs nnimap-incoming-split-list))
-		sequences)
+		sequences junk-articles)
 	    ;; Create any groups that doesn't already exist on the
 	    ;; server first.
 	    (dolist (spec specs)
-	      (unless (member (car spec) groups)
+	      (when (and (not (member (car spec) groups))
+			 (not (eq (car spec) 'junk)))
 		(nnimap-command "CREATE %S" (utf7-encode (car spec) t))))
 	    ;; Then copy over all the messages.
 	    (erase-buffer)
 	    (dolist (spec specs)
 	      (let ((group (car spec))
 		    (ranges (cdr spec)))
-		(push (list (nnimap-send-command "UID COPY %s %S"
-						 (nnimap-article-ranges ranges)
-						 (utf7-encode group t))
-			    ranges)
-		      sequences)))
+		(if (eq group 'junk)
+		    (setq junk-articles ranges)
+		  (push (list (nnimap-send-command
+			       "UID COPY %s %S"
+			       (nnimap-article-ranges ranges)
+			       (utf7-encode group t))
+			      ranges)
+			sequences))))
 	    ;; Wait for the last COPY response...
 	    (when sequences
 	      (nnimap-wait-for-response (caar sequences))
 	      ;; And then mark the successful copy actions as deleted,
 	      ;; and possibly expunge them.
 	      (nnimap-mark-and-expunge-incoming
-	       (nnimap-parse-copied-articles sequences)))))))))
+	       (nnimap-parse-copied-articles sequences))
+	      (nnimap-mark-and-expunge-incoming junk-articles))))))))
 
 (defun nnimap-mark-and-expunge-incoming (range)
   (when range
@@ -1125,7 +1154,7 @@
 	(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
+       (nnimap-expunge
 	(setq sequence (nnimap-send-command "EXPUNGE"))))
       (nnimap-wait-for-response sequence))))
 
@@ -1142,8 +1171,8 @@
   (let (new)
     (dolist (elem flags)
       (when (or (null (cdr elem))
-		(and (not (member "\\Deleted" (cdr elem)))
-		     (not (member "\\Seen" (cdr elem)))))
+		(and (not (memq '%Deleted (cdr elem)))
+		     (not (memq '%Seen (cdr elem)))))
 	(push (car elem) new)))
     (gnus-compress-sequence (nreverse new))))
 
@@ -1190,7 +1219,10 @@
     (if (not (re-search-forward "X-nnimap-article: \\([0-9]+\\)" nil t))
 	(error "Invalid nnimap mail")
       (setq article (string-to-number (match-string 1))))
-    (push (list article group-art)
+    (push (list article
+		(if (eq group-art 'junk)
+		    (list (cons 'junk 1))
+		  group-art))
 	  nnimap-incoming-split-list)))
 
 (provide 'nnimap)
--- a/lisp/gnus/nnmail.el	Thu Sep 23 01:14:00 2010 +0200
+++ b/lisp/gnus/nnmail.el	Thu Sep 23 00:30:37 2010 +0000
@@ -963,7 +963,7 @@
 	(goto-char end)))
     count))
 
-(defun nnmail-process-mmdf-mail-format (func artnum-func)
+(defun nnmail-process-mmdf-mail-format (func artnum-func &optional junk-func)
   (let ((delim "^\^A\^A\^A\^A$")
 	(case-fold-search t)
 	(count 0)
@@ -1011,7 +1011,7 @@
 	    (narrow-to-region start (point))
 	    (goto-char (point-min))
 	    (incf count)
-	    (nnmail-check-duplication message-id func artnum-func)
+	    (nnmail-check-duplication message-id func artnum-func junk-func)
 	    (setq end (point-max))))
 	(goto-char end)
 	(forward-line 2)))
@@ -1056,7 +1056,7 @@
   "Non-nil means group names are not encoded.")
 
 (defun nnmail-split-incoming (incoming func &optional exit-func
-				       group artnum-func)
+				       group artnum-func junk-func)
   "Go through the entire INCOMING file and pick out each individual mail.
 FUNC will be called with the buffer narrowed to each mail.
 INCOMING can also be a buffer object.  In that case, the mail
@@ -1087,7 +1087,8 @@
 		       (looking-at "BABYL OPTIONS:"))
 		   (nnmail-process-babyl-mail-format func artnum-func))
 		  ((looking-at "\^A\^A\^A\^A")
-		   (nnmail-process-mmdf-mail-format func artnum-func))
+		   (nnmail-process-mmdf-mail-format
+		    func artnum-func junk-func))
 		  ((looking-at "Return-Path:")
 		   (nnmail-process-maildir-mail-format func artnum-func))
 		  (t
@@ -1096,7 +1097,7 @@
 	  (funcall exit-func))
 	(kill-buffer (current-buffer))))))
 
-(defun nnmail-article-group (func &optional trace)
+(defun nnmail-article-group (func &optional trace junk-func)
   "Look at the headers and return an alist of groups that match.
 FUNC will be called with the group name to determine the article number."
   (let ((methods (or nnmail-split-methods '(("bogus" ""))))
@@ -1163,9 +1164,10 @@
 	      ;; The article may be "cross-posted" to `junk'.  What
 	      ;; to do?  Just remove the `junk' spec.  Don't really
 	      ;; see anything else to do...
-	      (let (elem)
-		(while (setq elem (car (memq 'junk split)))
-		  (setq split (delq elem split))))
+	      (when (and (memq 'junk split)
+			 junk-func)
+		(funcall junk-func 'junk))
+	      (setq split (delq 'junk split))
 	      (when split
 		(setq group-art
 		      (mapcar
@@ -1714,7 +1716,8 @@
       (message-narrow-to-head)
       (message-fetch-field header))))
 
-(defun nnmail-check-duplication (message-id func artnum-func)
+(defun nnmail-check-duplication (message-id func artnum-func
+					    &optional junk-func)
   (run-hooks 'nnmail-prepare-incoming-message-hook)
   ;; If this is a duplicate message, then we do not save it.
   (let* ((duplication (nnmail-cache-id-exists-p message-id))
@@ -1739,7 +1742,8 @@
     (cond
      ((not duplication)
       (funcall func (setq group-art
-			  (nreverse (nnmail-article-group artnum-func))))
+			  (nreverse (nnmail-article-group
+				     artnum-func nil junk-func))))
       (nnmail-cache-insert message-id (caar group-art)))
      ((eq action 'delete)
       (setq group-art nil))