changeset 110470:937bcfd8c509

merge trunk
author Kenichi Handa <handa@m17n.org>
date Wed, 22 Sep 2010 11:56:28 +0900
parents 9fa0b071facc (current diff) 5facdac279df (diff)
children 6afc6a92ca9b ee58b36ab139
files src/ChangeLog
diffstat 18 files changed, 568 insertions(+), 310 deletions(-) [+]
line wrap: on
line diff
--- a/doc/misc/ChangeLog	Wed Sep 22 11:54:58 2010 +0900
+++ b/doc/misc/ChangeLog	Wed Sep 22 11:56:28 2010 +0900
@@ -1,3 +1,8 @@
+2010-09-21  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* gnus.texi (Expunging mailboxes): Update name of the expunging
+	command.
+
 2010-09-20  Katsumi Yamaoka  <yamaoka@jpl.org>
 
 	* emacs-mime.texi (rfc2047): Update description for
--- a/doc/misc/gnus.texi	Wed Sep 22 11:54:58 2010 +0900
+++ b/doc/misc/gnus.texi	Wed Sep 22 11:56:28 2010 +0900
@@ -18384,7 +18384,7 @@
 @cindex expunge
 @cindex manual expunging
 @kindex G x (Group)
-@findex gnus-group-nnimap-expunge
+@findex gnus-group-expunge-group
 
 If you're using the @code{never} setting of @code{nnimap-expunge-on-close},
 you may want the option of expunging all deleted articles in a mailbox
--- a/lisp/ChangeLog	Wed Sep 22 11:54:58 2010 +0900
+++ b/lisp/ChangeLog	Wed Sep 22 11:56:28 2010 +0900
@@ -1,3 +1,10 @@
+2010-09-21  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* emacs-lisp/smie.el (smie-debug--describe-cycle): Fix typo.
+	(smie-indent-comment): Be more careful with comment-start-skip.
+	(smie-indent-comment-close, smie-indent-comment-inside): New funs.
+	(smie-indent-functions): Use them.
+
 2010-09-21  Michael Albinus  <michael.albinus@gmx.de>
 
 	* net/ange-ftp.el (ange-ftp-skip-msgs): Add "^504 ..." message.
--- a/lisp/emacs-lisp/smie.el	Wed Sep 22 11:54:58 2010 +0900
+++ b/lisp/emacs-lisp/smie.el	Wed Sep 22 11:56:28 2010 +0900
@@ -338,7 +338,7 @@
                      res))
                  cycle)))
     (mapconcat
-     (lambda (elems) (mapconcat 'indentity elems "="))
+     (lambda (elems) (mapconcat 'identity elems "="))
      (append names (list (car names)))
      " < ")))
 
@@ -1173,7 +1173,11 @@
   ;; front of a comment" when doing virtual-indentation anyway.  And if we are
   ;; (as can happen in octave-mode), moving forward can lead to inf-loops.
   (and (smie-indent--bolp)
-       (looking-at comment-start-skip)
+       (let ((pos (point)))
+         (save-excursion
+           (beginning-of-line)
+           (and (re-search-forward comment-start-skip (line-end-position) t)
+                (eq pos (or (match-end 1) (match-beginning 0))))))
        (save-excursion
          (forward-comment (point-max))
          (skip-chars-forward " \t\r\n")
@@ -1194,6 +1198,20 @@
                (if (looking-at (regexp-quote continue))
                    (current-column))))))))
 
+(defun smie-indent-comment-close ()
+  (and (boundp 'comment-end-skip)
+       comment-end-skip
+       (not (looking-at " \t*$"))       ;Not just a \n comment-closer.
+       (looking-at comment-end-skip)
+       (nth 4 (syntax-ppss))
+       (save-excursion
+         (goto-char (nth 8 (syntax-ppss)))
+         (current-column))))
+
+(defun smie-indent-comment-inside ()
+  (and (nth 4 (syntax-ppss))
+       'noindent))
+
 (defun smie-indent-after-keyword ()
   ;; Indentation right after a special keyword.
   (save-excursion
@@ -1275,9 +1293,10 @@
            (current-column)))))))
 
 (defvar smie-indent-functions
-  '(smie-indent-fixindent smie-indent-bob smie-indent-close smie-indent-comment
-   smie-indent-comment-continue smie-indent-keyword smie-indent-after-keyword
-   smie-indent-exps)
+  '(smie-indent-fixindent smie-indent-bob smie-indent-close
+    smie-indent-comment smie-indent-comment-continue smie-indent-comment-close
+    smie-indent-comment-inside smie-indent-keyword smie-indent-after-keyword
+    smie-indent-exps)
   "Functions to compute the indentation.
 Each function is called with no argument, shouldn't move point, and should
 return either nil if it has no opinion, or an integer representing the column
--- a/lisp/gnus/ChangeLog	Wed Sep 22 11:54:58 2010 +0900
+++ b/lisp/gnus/ChangeLog	Wed Sep 22 11:56:28 2010 +0900
@@ -1,3 +1,81 @@
+2010-09-21  Adam Sjøgren  <asjo@koldfront.dk>
+
+	* gnus-sum.el (gnus-adjust-marked-articles): Fix typo.
+
+2010-09-21  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* gnus-int.el (gnus-open-server): Give a better error message in the
+	"go offline" case.
+
+	* gnus-sum.el (gnus-adjust-marked-articles): Hack to avoid adjusting
+	marks for nnimap, which is seldom the right thing to do.
+
+	* gnus.el (gnus-sloppily-equal-method-parameters): Refactor out.
+	(gnus-same-method-different-name): New function.
+
+	* nnimap.el (parse-time): Require.
+
+	* gnus-start.el (gnus-get-unread-articles): Fix the prefixed select
+	method in the presence of many similar methods.
+
+	* nnmail.el (nnmail-expired-article-p): Fix typo: time-subtract.
+
+	* nnimap.el (nnimap-find-expired-articles): Don't refer to
+	nnml-inhibit-expiry.
+
+	* gnus-sum.el (gnus-summary-move-article): Use gnus-server-equal to
+	find out whether methods are equal.
+
+	* nnimap.el (nnimap-find-expired-articles): New function.
+	(nnimap-process-expiry-targets): New function.
+	(nnimap-request-move-article): Request the article before looking at
+	what the Message-ID is.  Fix found by Andrew Cohen.
+	(nnimap-mark-and-expunge-incoming): Wait for the last sequence.
+
+	* nnmail.el (nnmail-expired-article-p): Allow returning the cutoff time
+	for oldness in addition to being a predicate.
+
+	* nnimap.el (nnimap-request-group): When we have zero articles, return
+	the right data to Gnus.
+	(nnimap-request-expire-articles): Only delete articles immediately if
+	the target is 'delete.
+
+	* gnus-sum.el (gnus-summary-move-article): When respooling to the same
+	method, this would bug out.
+
+	* gnus-group.el (gnus-group-expunge-group): Renamed from
+	gnus-group-nnimap-expunge, and implemented as a normal interface
+	function.
+
+	* gnus-int.el (gnus-request-expunge-group): New function.
+
+	* nnimap.el (nnimap-request-create-group): Implement.
+	(nnimap-request-expunge-group): New function.
+
+2010-09-21  Julien Danjou  <julien@danjou.info>
+
+	* gnus-html.el (gnus-html-image-cache-ttl): Add new variable.
+	(gnus-html-cache-expired): Add new function.
+	(gnus-html-wash-images): Use `gnus-html-cache-expired' to check
+	wethever we should display image for fetch it.
+	Compute alt-text earlier to pass it to the fetching function too.
+	(gnus-html-schedule-image-fetching): Change function argument to only
+	get one image at a time, not a list.
+	(gnus-html-image-fetched): Use `url-store-in-cache' to store image in
+	cache.
+	(gnus-html-get-image-data): New function to retrieve image data from
+	cache.
+	(gnus-html-put-image): Change buffer argument to use image data rather
+	than file, and place image above region rather than inserting a new
+	one. Do not take alt-text as argument, since it's useless now: we place
+	the image above alt-text.
+	(gnus-html-prune-cache): Remove.
+	(gnus-html-show-images): Start to fetch image when we find one, do not
+	push into a temporary list.
+	(gnus-html-prefetch-images): Only fetch image if they have expired.
+	(gnus-html-browse-image): Fix, use 'gnus-image-url.
+	(gnus-html-image-map): Add "v" to browse-url on undisplayed image.
+
 2010-09-20  Katsumi Yamaoka  <yamaoka@jpl.org>
 
 	* rfc2047.el (rfc2047-encode-parameter): Doc fix.
--- a/lisp/gnus/gnus-group.el	Wed Sep 22 11:54:58 2010 +0900
+++ b/lisp/gnus/gnus-group.el	Wed Sep 22 11:56:28 2010 +0900
@@ -509,7 +509,10 @@
 		   (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
 	      (t number)) ?s)
     (?R gnus-tmp-number-of-read ?s)
-    (?U (gnus-number-of-unseen-articles-in-group gnus-tmp-group) ?d)
+    (?U (if (gnus-active gnus-tmp-group)
+	    (gnus-number-of-unseen-articles-in-group gnus-tmp-group)
+	  "*")
+	?s)
     (?t gnus-tmp-number-total ?d)
     (?y gnus-tmp-number-of-unread ?s)
     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
@@ -675,7 +678,7 @@
   "R" gnus-group-make-rss-group
   "c" gnus-group-customize
   "z" gnus-group-compact-group
-  "x" gnus-group-nnimap-expunge
+  "x" gnus-group-expunge-group
   "\177" gnus-group-delete-group
   [delete] gnus-group-delete-group)
 
@@ -3163,21 +3166,17 @@
 		       'summary 'group)))
       (error "Couldn't enter %s" dir))))
 
-(autoload 'nnimap-expunge "nnimap")
-(autoload 'nnimap-acl-get "nnimap")
-(autoload 'nnimap-acl-edit "nnimap")
-
-(defun gnus-group-nnimap-expunge (group)
+(defun gnus-group-expunge-group (group)
   "Expunge deleted articles in current nnimap GROUP."
   (interactive (list (gnus-group-group-name)))
-  (let ((mailbox (gnus-group-real-name group)) method)
-    (unless group
-      (error "No group on current line"))
-    (unless (gnus-get-info group)
-      (error "Killed group; can't be edited"))
-    (unless (eq 'nnimap (car (setq method (gnus-find-method-for-group group))))
-      (error "%s is not an nnimap group" group))
-    (nnimap-expunge mailbox (cadr method))))
+  (let ((method (gnus-find-method-for-group group)))
+    (if (not (gnus-check-backend-function
+	      'request-expunge-group (car method)))
+	(error "%s does not support expunging" (car method))
+      (gnus-request-expunge-group group method))))
+
+(autoload 'nnimap-acl-get "nnimap")
+(autoload 'nnimap-acl-edit "nnimap")
 
 (defun gnus-group-nnimap-edit-acl (group)
   "Edit the Access Control List of current nnimap GROUP."
--- a/lisp/gnus/gnus-html.el	Wed Sep 22 11:54:58 2010 +0900
+++ b/lisp/gnus/gnus-html.el	Wed Sep 22 11:56:28 2010 +0900
@@ -34,15 +34,10 @@
 (require 'gnus-art)
 (require 'mm-url)
 (require 'url)
+(require 'url-cache)
 
-(defcustom gnus-html-cache-directory (nnheader-concat gnus-directory "html-cache/")
-  "Where Gnus will cache images it downloads from the web."
-  :version "24.1"
-  :group 'gnus-art
-  :type 'directory)
-
-(defcustom gnus-html-cache-size 500000000
-  "The size of the Gnus image cache."
+(defcustom gnus-html-image-cache-ttl (days-to-time 7)
+  "Time in seconds used to cache the image on disk."
   :version "24.1"
   :group 'gnus-art
   :type 'integer)
@@ -73,6 +68,7 @@
   (let ((map (make-sparse-keymap)))
     (define-key map "u" 'gnus-article-copy-string)
     (define-key map "i" 'gnus-html-insert-image)
+    (define-key map "v" 'gnus-html-browse-url)
     map))
 
 (defvar gnus-html-displayed-image-map
@@ -84,6 +80,19 @@
     (define-key map [tab] 'widget-forward)
     map))
 
+(defun gnus-html-cache-expired (url ttl)
+  "Check if URL is cached for more than TTL."
+  (cond (url-standalone-mode
+         (not (file-exists-p (url-cache-create-filename url))))
+        (t (let ((cache-time (url-is-cached url)))
+             (if cache-time
+                 (time-less-p
+                  (time-add
+                   cache-time
+                   ttl)
+                  (current-time))
+               t)))))
+
 ;;;###autoload
 (defun gnus-article-html (&optional handle)
   (let ((article-buffer (current-buffer)))
@@ -133,6 +142,7 @@
     (replace-match "" t t)))
 
 (defun gnus-html-wash-images ()
+  "Run through current buffer and replace img tags by images."
   (let (tag parameters string start end images url)
     (goto-char (point-min))
     ;; Search for all the images first.
@@ -158,62 +168,68 @@
 		  (setq image (gnus-create-image (buffer-string)
 						 nil t))))
 	      (when image
-		(let ((string (buffer-substring start end)))
-		  (delete-region start end)
-		  (gnus-put-image image (gnus-string-or string "*") 'cid)
-		  (gnus-add-image 'cid image))))
+                (let ((string (buffer-substring start end)))
+                  (delete-region start end)
+                  (gnus-put-image image (gnus-string-or string "*") 'cid)
+                  (gnus-add-image 'cid image))))
 	  ;; Normal, external URL.
-	  (if (gnus-html-image-url-blocked-p
-	       url
-	       (if (buffer-live-p gnus-summary-buffer)
-		   (with-current-buffer gnus-summary-buffer
-		     gnus-blocked-images)
-		 gnus-blocked-images))
-	      (progn
-		(widget-convert-button
-		 'link start end
-		 :action 'gnus-html-insert-image
-		 :help-echo url
-		 :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))))
-		  (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 spec)))
-	    (let ((file (gnus-html-image-id url))
-		  width height alt-text)
-	      (when (string-match "height=\"?\\([0-9]+\\)" parameters)
-		(setq height (string-to-number (match-string 1 parameters))))
-	      (when (string-match "width=\"?\\([0-9]+\\)" parameters)
-		(setq width (string-to-number (match-string 1 parameters))))
-	      (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)"
-				  parameters)
-		(setq alt-text (match-string 2 parameters)))
-	      ;; Don't fetch images that are really small.  They're
-	      ;; probably tracking pictures.
-	      (when (and (or (null height)
-			     (> height 4))
-			 (or (null width)
-			     (> width 4)))
-		(if (file-exists-p file)
-		    ;; It's already cached, so just insert it.
-		    (let ((string (buffer-substring start end)))
-		      ;; Delete the IMG text.
-		      (delete-region start end)
-		      (gnus-html-put-image file (point) string url alt-text))
-		  ;; We don't have it, so schedule it for fetching
-		  ;; asynchronously.
-		  (push (list url
-			      (set-marker (make-marker) start)
-			      (point-marker))
-			images))))))))
-    (when images
-      (gnus-html-schedule-image-fetching (current-buffer) (nreverse images)))))
+          (let ((alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)"
+                                              parameters)
+                            (match-string 2 parameters))))
+            (if (gnus-html-image-url-blocked-p
+                 url
+                 (if (buffer-live-p gnus-summary-buffer)
+                     (with-current-buffer gnus-summary-buffer
+                       gnus-blocked-images)
+                   gnus-blocked-images))
+                (progn
+                  (widget-convert-button
+                   'link start end
+                   :action 'gnus-html-insert-image
+                   :help-echo url
+                   :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)))
+                    (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)))
+              ;; Non-blocked url
+              (let ((width
+                     (when (string-match "width=\"?\\([0-9]+\\)" parameters)
+                       (string-to-number (match-string 1 parameters))))
+                    (height
+                     (when (string-match "height=\"?\\([0-9]+\\)" parameters)
+                       (string-to-number (match-string 1 parameters)))))
+                ;; Don't fetch images that are really small.  They're
+                ;; probably tracking pictures.
+                (when (and (or (null height)
+                               (> height 4))
+                           (or (null width)
+                               (> width 4)))
+                  (gnus-html-display-image url start end alt-text))))))))))
+
+(defun gnus-html-display-image (url start end alt-text)
+  "Display image at URL on text from START to END.
+Use ALT-TEXT for the image string."
+  (if (gnus-html-cache-expired url gnus-html-image-cache-ttl)
+      ;; We don't have it, so schedule it for fetching
+      ;; asynchronously.
+      (gnus-html-schedule-image-fetching
+       (current-buffer)
+       (list url
+             (set-marker (make-marker) start)
+             (set-marker (make-marker) end)
+             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)))
 
 (defun gnus-html-wash-tags ()
   (let (tag parameters string start end images url)
@@ -300,8 +316,7 @@
 (defun gnus-html-insert-image ()
   "Fetch and insert the image under point."
   (interactive)
-  (gnus-html-schedule-image-fetching
-   (current-buffer) (list (get-text-property (point) 'gnus-image))))
+  (apply 'gnus-html-display-image (get-text-property (point) 'gnus-image)))
 
 (defun gnus-html-show-alt-text ()
   "Show the ALT text of the image under point."
@@ -311,7 +326,7 @@
 (defun gnus-html-browse-image ()
   "Browse the image under point."
   (interactive)
-  (browse-url (get-text-property (point) 'gnus-image)))
+  (browse-url (get-text-property (point) 'gnus-image-url)))
 
 (defun gnus-html-browse-url ()
   "Browse the image under point."
@@ -321,87 +336,89 @@
 	(message "No URL at point")
       (browse-url url))))
 
-(defun gnus-html-schedule-image-fetching (buffer images)
-  (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, images %s"
-                buffer images)
-  (dolist (image images)
-    (ignore-errors
-      (url-retrieve (car image)
-		    'gnus-html-image-fetched
-		    (list buffer image)))))
-
-(defun gnus-html-image-id (url)
-  (expand-file-name (sha1 url) gnus-html-cache-directory))
+(defun gnus-html-schedule-image-fetching (buffer image)
+  "Retrieve IMAGE, and place it into BUFFER on arrival."
+  (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, image %s"
+                buffer image)
+  (ignore-errors
+    (url-retrieve (car image)
+                  'gnus-html-image-fetched
+                  (list buffer image))))
 
 (defun gnus-html-image-fetched (status buffer image)
-  (let ((file (gnus-html-image-id (car image))))
-    ;; Search the start of the image data
+  (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))))))
+  (kill-buffer (current-buffer)))
+
+(defun gnus-html-get-image-data (url)
+  "Get image data for URL.
+Return a string with image data."
+  (with-temp-buffer
+    (mm-disable-multibyte)
+    (url-cache-extract (url-cache-create-filename url))
     (when (search-forward "\n\n" nil t)
-      ;; Write region (image data) silently
-      (write-region (point) (point-max) file nil 1)
-      (kill-buffer (current-buffer))
-      (when (and (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)) (point-min))))
-	(with-current-buffer buffer
-	  (let ((inhibit-read-only t)
-		(string (buffer-substring (cadr image) (caddr image))))
-	    (delete-region (cadr image) (caddr image))
-	    (gnus-html-put-image file (cadr image) (car image) string)))))))
+      (buffer-substring (point) (point-max)))))
 
-(defun gnus-html-put-image (file point string &optional url alt-text)
+(defun gnus-html-put-image (data start end &optional url alt-text)
   (when (gnus-graphic-display-p)
     (let* ((image (ignore-errors
-		   (gnus-create-image file)))
-	  (size (and image
-		     (if (featurep 'xemacs)
-			 (cons (glyph-width image) (glyph-height image))
-		       (image-size image t)))))
+                    (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 point)
-	(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 ((data (cdadar (specifier-spec-list
-							(glyph-image image)))))
-				     (and (vectorp data)
-					  (aref data 0)))
-				 (plist-get (cdr image) :type))
-			       'gif)
-			   (= (car size) 30)
-			   (= (cdr size) 30))))
-	    (let ((start (point)))
-	      (setq image (gnus-html-rescale-image image file size))
-	      (gnus-put-image image
-			      (gnus-string-or string "*")
-			      'external)
-	      (let ((overlay (gnus-make-overlay start (point))))
-		(gnus-overlay-put overlay '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)))
-	      (gnus-add-image 'external image)
-	      t)
-	  (insert string)
-	  (when (fboundp 'find-image)
-	    (setq image (find-image '((:type xpm :file "lock-broken.xpm"))))
-	    (gnus-put-image image
-			    (gnus-string-or string "*")
-			    'internal)
-	    (gnus-add-image 'internal image))
-	  nil)))))
+	(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-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))))))
 
-(defun gnus-html-rescale-image (image file size)
+(defun gnus-html-rescale-image (image data size)
   (if (or (not (fboundp 'imagemagick-types))
 	  (not (get-buffer-window (current-buffer))))
       image
@@ -414,35 +431,17 @@
 				       (- (nth 3 edges) (nth 1 edges)))))
 	   scaled-image)
       (when (> height window-height)
-	(setq image (or (create-image file 'imagemagick nil
+	(setq image (or (create-image data 'imagemagick t
 				      :height window-height)
 			image))
 	(setq size (image-size image t)))
       (when (> (car size) window-width)
 	(setq image (or
-		     (create-image file 'imagemagick nil
+		     (create-image data 'imagemagick t
 				   :width window-width)
 		     image)))
       image)))
 
-(defun gnus-html-prune-cache ()
-  (let ((total-size 0)
-	files)
-    (dolist (file (directory-files gnus-html-cache-directory t nil t))
-      (let ((attributes (file-attributes file)))
-	(unless (nth 0 attributes)
-	  (incf total-size (nth 7 attributes))
-	  (push (list (time-to-seconds (nth 5 attributes))
-		      (nth 7 attributes) file)
-		files))))
-    (when (> total-size gnus-html-cache-size)
-      (setq files (sort files (lambda (f1 f2)
-				(< (car f1) (car f2)))))
-      (dolist (file files)
-	(when (> total-size gnus-html-cache-size)
-	  (decf total-size (cadr file))
-	  (delete-file (nth 2 file)))))))
-
 (defun gnus-html-image-url-blocked-p (url blocked-images)
   "Find out if URL is blocked by BLOCKED-IMAGES."
   (let ((ret (and blocked-images
@@ -459,14 +458,10 @@
 This only works if the article in question is HTML."
   (interactive)
   (gnus-with-article-buffer
-    (let ((overlays (overlays-in (point-min) (point-max)))
-	  overlay images)
-      (while (setq overlay (pop overlays))
-	(when (overlay-get overlay 'gnus-image)
-	  (push (overlay-get overlay 'gnus-image) images)))
-      (if (not images)
-	  (message "No images to show")
-	(gnus-html-schedule-image-fetching (current-buffer) images)))))
+    (dolist (overlay (overlays-in (point-min) (point-max)))
+      (let ((o (overlay-get overlay 'gnus-image)))
+        (when o
+          (apply 'gnus-html-display-image o))))))
 
 ;;;###autoload
 (defun gnus-html-prefetch-images (summary)
@@ -477,11 +472,9 @@
 	(while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t)
 	  (let ((url (match-string 1)))
 	    (unless (gnus-html-image-url-blocked-p url blocked-images)
-              (unless (file-exists-p (gnus-html-image-id url))
-                (ignore-errors
-                  (url-retrieve (mm-url-decode-entities-string url)
-                                'gnus-html-image-fetched
-				(list nil (list url))))))))))))
+              (when (gnus-html-cache-expired url gnus-html-image-cache-ttl)
+                (gnus-html-schedule-image-fetching nil
+                                                   (list url))))))))))
 
 (provide 'gnus-html)
 
--- a/lisp/gnus/gnus-int.el	Wed Sep 22 11:54:58 2010 +0900
+++ b/lisp/gnus/gnus-int.el	Wed Sep 22 11:56:28 2010 +0900
@@ -275,8 +275,10 @@
 			       (not gnus-batch-mode)
 			       (gnus-y-or-n-p
 				(format
-				 "Unable to open server %s, go offline? "
-				 server)))
+				 "Unable to open server %s (%s), go offline? "
+				 server
+				 (nnheader-get-report
+				  (car gnus-command-method)))))
                               (setq open-offline t)
                               'offline)
                              (t
@@ -552,6 +554,14 @@
   (funcall (gnus-get-function gnus-command-method 'request-post)
 	   (nth 1 gnus-command-method)))
 
+(defun gnus-request-expunge-group (group gnus-command-method)
+  "Expunge GROUP, which is removing articles that have been marked as deleted."
+  (when (stringp gnus-command-method)
+    (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+  (funcall (gnus-get-function gnus-command-method 'request-expunge-group)
+	   (gnus-group-real-name group)
+	   (nth 1 gnus-command-method)))
+
 (defun gnus-request-scan (group gnus-command-method)
   "Request a SCAN being performed in GROUP from GNUS-COMMAND-METHOD.
 If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
--- a/lisp/gnus/gnus-start.el	Wed Sep 22 11:54:58 2010 +0900
+++ b/lisp/gnus/gnus-start.el	Wed Sep 22 11:56:28 2010 +0900
@@ -705,6 +705,7 @@
 	nnoo-state-alist nil
 	gnus-current-select-method nil
 	nnmail-split-history nil
+	gnus-extended-servers nil
 	gnus-ephemeral-servers nil)
   (gnus-shutdown 'gnus)
   ;; Kill the startup file.
@@ -1693,28 +1694,19 @@
     (while newsrc
       (setq active (gnus-active (setq group (gnus-info-group
 					     (setq info (pop newsrc))))))
-
-      ;; Check newsgroups.  If the user doesn't want to check them, or
-      ;; they can't be checked (for instance, if the news server can't
-      ;; be reached) we just set the number of unread articles in this
-      ;; newsgroup to t.  This means that Gnus thinks that there are
-      ;; unread articles, but it has no idea how many.
-
-      ;; To be more explicit:
-      ;; >0 for an active group with messages
-      ;; 0 for an active group with no unread messages
-      ;; nil for non-foreign groups that the user has requested not be checked
-      ;; t for unchecked foreign groups or bogus groups, or groups that can't
-      ;;   be checked, for one reason or other.
-
       ;; First go through all the groups, see what select methods they
       ;; belong to, and then collect them into lists per unique select
       ;; method.
       (if (not (setq method (gnus-info-method info)))
 	  (setq method gnus-select-method)
+	;; There may be several similar methods.  Possibly extend the
+	;; method.
 	(if (setq cmethod (assoc method methods-cache))
 	    (setq method (cdr cmethod))
-	  (setq cmethod (inline (gnus-server-get-method nil method)))
+	  (setq cmethod (if (stringp method)
+			    (gnus-server-to-method method)
+			  (inline (gnus-find-method-for-group
+				   (gnus-info-group info) info))))
 	  (push (cons method cmethod) methods-cache)
 	  (setq method cmethod)))
       (setq method-group-list (assoc method type-cache))
--- a/lisp/gnus/gnus-sum.el	Wed Sep 22 11:54:58 2010 +0900
+++ b/lisp/gnus/gnus-sum.el	Wed Sep 22 11:56:28 2010 +0900
@@ -5850,6 +5850,10 @@
 	 (types gnus-article-mark-lists)
 	 marks var articles article mark mark-type
          bgn end)
+    ;; Hack to avoid adjusting marks for imap.
+    (when (eq (car (gnus-find-method-for-group (gnus-info-group info)))
+	      'nnimap)
+      (setq min 1))
 
     (dolist (marks marked-lists)
       (setq mark (car marks)
@@ -9681,7 +9685,7 @@
 			      gnus-newsgroup-name))
 		(to-method (or select-method
 			       (gnus-find-method-for-group to-newsgroup)))
-		(move-is-internal (gnus-method-equal from-method to-method)))
+		(move-is-internal (gnus-server-equal from-method to-method)))
 	   (gnus-request-move-article
 	    article			; Article to move
 	    gnus-newsgroup-name		; From newsgroup
@@ -9692,7 +9696,8 @@
 		  (not articles) t)	; Accept form
 	    (not articles)		; Only save nov last time
 	    (and move-is-internal
-		 (gnus-group-real-name to-newsgroup))))) ; is this move internal?
+		 to-newsgroup		; Not respooling
+		 (gnus-group-real-name to-newsgroup))))) ; Is this move internal?
 	;; Copy the article.
 	((eq action 'copy)
 	 (with-current-buffer copy-buf
--- a/lisp/gnus/gnus.el	Wed Sep 22 11:54:58 2010 +0900
+++ b/lisp/gnus/gnus.el	Wed Sep 22 11:56:28 2010 +0900
@@ -2682,6 +2682,7 @@
 (defvar gnus-newsgroup-name nil)
 (defvar gnus-ephemeral-servers nil)
 (defvar gnus-server-method-cache nil)
+(defvar gnus-extended-servers nil)
 
 (defvar gnus-agent-fetching nil
   "Whether Gnus agent is in fetching mode.")
@@ -3686,32 +3687,35 @@
    (and
     (eq (car m1) (car m2))
     (equal (cadr m1) (cadr m2))
-    ;; Check parameters for sloppy equalness.
-    (let ((p1 (copy-list (cddr m1)))
-	  (p2 (copy-list (cddr m2)))
-	  e1 e2)
-      (block nil
-	(while (setq e1 (pop p1))
-	  (unless (setq e2 (assq (car e1) p2))
-	    ;; The parameter doesn't exist in p2.
-	    (return nil))
-	  (setq p2 (delq e2 p2))
-	  (unless (equalp e1 e2)
-	    (if (not (and (stringp (cadr e1))
-			  (stringp (cadr e2))))
-		(return nil)
-	      ;; Special-case string parameter comparison so that we
-	      ;; can uniquify them.
-	      (let ((s1 (cadr e1))
-		    (s2 (cadr e2)))
-		(when (string-match "/$" s1)
-		  (setq s1 (directory-file-name s1)))
-		(when (string-match "/$" s2)
-		  (setq s2 (directory-file-name s2)))
-		(unless (equal s1 s2)
-		  (return nil))))))
-	;; If p2 now is empty, they were equal.
-	(null p2))))))
+    (gnus-sloppily-equal-method-parameters m1 m2))))
+
+(defsubst gnus-sloppily-equal-method-parameters (m1 m2)
+  ;; Check parameters for sloppy equalness.
+  (let ((p1 (copy-list (cddr m1)))
+	(p2 (copy-list (cddr m2)))
+	e1 e2)
+    (block nil
+      (while (setq e1 (pop p1))
+	(unless (setq e2 (assq (car e1) p2))
+	  ;; The parameter doesn't exist in p2.
+	  (return nil))
+	(setq p2 (delq e2 p2))
+	(unless (equalp e1 e2)
+	  (if (not (and (stringp (cadr e1))
+			(stringp (cadr e2))))
+	      (return nil)
+	    ;; Special-case string parameter comparison so that we
+	    ;; can uniquify them.
+	    (let ((s1 (cadr e1))
+		  (s2 (cadr e2)))
+	      (when (string-match "/$" s1)
+		(setq s1 (directory-file-name s1)))
+	      (when (string-match "/$" s2)
+		(setq s2 (directory-file-name s2)))
+	      (unless (equal s1 s2)
+		(return nil))))))
+      ;; If p2 now is empty, they were equal.
+      (null p2))))
 
 (defun gnus-server-equal (m1 m2)
   "Say whether two methods are equal."
@@ -4200,9 +4204,12 @@
   (if (or (not (inline (gnus-similar-server-opened method)))
 	  (not (cddr method)))
       method
-    `(,(car method) ,(concat (cadr method) "+" group)
-      (,(intern (format "%s-address" (car method))) ,(cadr method))
-      ,@(cddr method))))
+    (setq method
+	  `(,(car method) ,(concat (cadr method) "+" group)
+	    (,(intern (format "%s-address" (car method))) ,(cadr method))
+	    ,@(cddr method)))
+    (push method gnus-extended-servers)
+    method))
 
 (defun gnus-server-status (method)
   "Return the status of METHOD."
@@ -4227,6 +4234,20 @@
 	(format "%s using %s" address (car server))
       (format "%s" (car server)))))
 
+(defun gnus-same-method-different-name (method)
+  (let ((slot (intern (concat (symbol-name (car method)) "-address"))))
+    (unless (assq slot (cddr method))
+      (setq method
+	    (append method (list (list slot (nth 1 method)))))))
+  (let ((methods gnus-extended-servers)
+	open found)
+    (while (and (not found)
+		(setq open (pop methods)))
+      (when (and (eq (car method) (car open))
+		 (gnus-sloppily-equal-method-parameters method open))
+	(setq found open)))
+    found))
+
 (defun gnus-find-method-for-group (group &optional info)
   "Find the select method that GROUP uses."
   (or gnus-override-method
@@ -4249,7 +4270,10 @@
 		(cond ((stringp method)
 		       (inline (gnus-server-to-method method)))
 		      ((stringp (cadr method))
-		       (inline (gnus-server-extend-method group method)))
+		       (or
+			(inline
+			 (gnus-same-method-different-name method))
+			(inline (gnus-server-extend-method group method))))
 		      (t
 		       method)))
 	  (cond ((equal (cadr method) "")
--- a/lisp/gnus/nnimap.el	Wed Sep 22 11:54:58 2010 +0900
+++ b/lisp/gnus/nnimap.el	Wed Sep 22 11:56:28 2010 +0900
@@ -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)
--- a/lisp/gnus/nnmail.el	Wed Sep 22 11:54:58 2010 +0900
+++ b/lisp/gnus/nnmail.el	Wed Sep 22 11:56:28 2010 +0900
@@ -1858,9 +1858,12 @@
       (run-hooks 'nnmail-post-get-new-mail-hook))))
 
 (defun nnmail-expired-article-p (group time force &optional inhibit)
-  "Say whether an article that is TIME old in GROUP should be expired."
+  "Say whether an article that is TIME old in GROUP should be expired.
+If TIME is nil, then return the cutoff time for oldness instead."
   (if force
-      t
+      (if (null time)
+	  (current-time)
+	t)
     (let ((days (or (and nnmail-expiry-wait-function
 			 (funcall nnmail-expiry-wait-function group))
 		    nnmail-expiry-wait)))
@@ -1871,14 +1874,18 @@
 	     nil)
 	    ((eq days 'immediate)
 	     ;; We expire all articles on sight.
-	     t)
+	     (if (null time)
+		 (current-time)
+	       t))
 	    ((equal time '(0 0))
 	    ;; This is an ange-ftp group, and we don't have any dates.
 	     nil)
 	    ((numberp days)
 	     (setq days (days-to-time days))
 	     ;; Compare the time with the current time.
-	     (ignore-errors (time-less-p days (time-since time))))))))
+	     (if (null time)
+		 (time-subtract (current-time) days)
+	       (ignore-errors (time-less-p days (time-since time)))))))))
 
 (declare-function gnus-group-mark-article-read "gnus-group" (group article))
 
--- a/lisp/gnus/nnml.el	Wed Sep 22 11:54:58 2010 +0900
+++ b/lisp/gnus/nnml.el	Wed Sep 22 11:56:28 2010 +0900
@@ -942,22 +942,23 @@
       (when (file-exists-p nov)
 	(funcall nnmail-delete-file-function nov))
       (dolist (file files)
-	(unless (file-directory-p (setq file (concat dir (cdr file))))
-	  (erase-buffer)
-	  (nnheader-insert-file-contents file)
-	  (narrow-to-region
-	   (goto-char (point-min))
-	   (progn
-	     (re-search-forward "\n\r?\n" nil t)
-	     (setq chars (- (point-max) (point)))
-	     (max (point-min) (1- (point)))))
-	  (unless (zerop (buffer-size))
-	    (goto-char (point-min))
-	    (setq headers (nnml-parse-head chars (car file)))
-	    (with-current-buffer nov-buffer
-	      (goto-char (point-max))
-	      (nnheader-insert-nov headers)))
-	  (widen)))
+	(let ((path (concat dir (cdr file))))
+	  (unless (file-directory-p path)
+	    (erase-buffer)
+	    (nnheader-insert-file-contents path)
+	    (narrow-to-region
+	     (goto-char (point-min))
+	     (progn
+	       (re-search-forward "\n\r?\n" nil t)
+	       (setq chars (- (point-max) (point)))
+	       (max (point-min) (1- (point)))))
+	    (unless (zerop (buffer-size))
+	      (goto-char (point-min))
+	      (setq headers (nnml-parse-head chars (car file)))
+	      (with-current-buffer nov-buffer
+		(goto-char (point-max))
+		(nnheader-insert-nov headers)))
+	    (widen))))
       (with-current-buffer nov-buffer
 	(nnmail-write-region (point-min) (point-max) nov nil 'nomesg)
 	(kill-buffer (current-buffer))))))
--- a/nt/configure.bat	Wed Sep 22 11:54:58 2010 +0900
+++ b/nt/configure.bat	Wed Sep 22 11:56:28 2010 +0900
@@ -1,6 +1,6 @@
 @echo off
 rem   ----------------------------------------------------------------------
-rem   Configuration script for MS Windows 95/98/Me and NT/2000/XP
+rem   Configuration script for MS Windows operating systems
 rem   Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005,
 rem      2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
 
@@ -22,7 +22,7 @@
 rem   ----------------------------------------------------------------------
 rem   YOU'LL NEED THE FOLLOWING UTILITIES TO MAKE EMACS:
 rem
-rem   + MS Windows 95/98/Me or NT/2000/XP
+rem   + MS Windows 95, NT or later
 rem   + either MSVC 2.x or later, or gcc-2.95 or later (with GNU make 3.75
 rem     or later) and the Mingw32 and W32 API headers and libraries.
 rem   + Visual Studio 2005 is not supported at this time.
@@ -116,6 +116,7 @@
 if "%1" == "--with-svg" goto withsvg
 if "%1" == "--distfiles" goto distfiles
 if "%1" == "" goto checkutils
+
 :usage
 echo Usage: configure [options]
 echo Options:
@@ -137,61 +138,82 @@
 echo.   --with-svg              use the RSVG library (experimental)
 echo.   --distfiles             path to files for make dist, e.g. libXpm.dll
 goto end
+
 rem ----------------------------------------------------------------------
+
 :setprefix
 shift
 set prefix=%1
 shift
 goto again
+
 rem ----------------------------------------------------------------------
+
 :withgcc
 set COMPILER=gcc
 shift
 goto again
+
 rem ----------------------------------------------------------------------
+
 :withmsvc
 set COMPILER=cl
 shift
 goto again
+
 rem ----------------------------------------------------------------------
+
 :nodebug
 set nodebug=Y
 shift
 goto again
+
 rem ----------------------------------------------------------------------
+
 :noopt
 set noopt=Y
 shift
 goto again
+
 rem ----------------------------------------------------------------------
+
 :enablechecking
 set enablechecking=Y
 shift
 goto again
+
 rem ----------------------------------------------------------------------
+
 :profile
 set profile=Y
 shift
 goto again
+
 rem ----------------------------------------------------------------------
+
 :nocygwin
 set nocygwin=Y
 shift
 goto again
+
 rem ----------------------------------------------------------------------
+
 :usercflags
 shift
 set usercflags=%usercflags%%sep1%%1
 set sep1= %nothing%
 shift
 goto again
+
 rem ----------------------------------------------------------------------
+
 :userldflags
 shift
 set userldflags=%userldflags%%sep2%%1
 set sep2= %nothing%
 shift
 goto again
+
 rem ----------------------------------------------------------------------
 
 :withoutpng
@@ -249,6 +271,7 @@
 
 rem ----------------------------------------------------------------------
 rem    Check that necessary utilities (cp and rm) are present.
+
 :checkutils
 echo Checking for 'cp'...
 cp configure.bat junk.bat
@@ -257,9 +280,11 @@
 rm junk.bat
 if exist junk.bat goto needrm
 goto checkcompiler
+
 :needcp
 echo You need 'cp' (the Unix file copy program) to build Emacs.
 goto end
+
 :needrm
 del junk.bat
 echo You need 'rm' (the Unix file delete program) to build Emacs.
@@ -267,6 +292,7 @@
 
 rem ----------------------------------------------------------------------
 rem   Auto-detect compiler if not specified, and validate GCC if chosen.
+
 :checkcompiler
 if (%COMPILER%)==(cl) goto compilercheckdone
 if (%COMPILER%)==(gcc) goto checkgcc
@@ -301,6 +327,7 @@
 :chkapi
 echo The failed program was: >>config.log
 type junk.c >>config.log
+
 :chkapiN
 rm -f junk.c junk.o
 rem ----------------------------------------------------------------------
@@ -320,8 +347,10 @@
 if (%nocygwin%) == (Y) goto chkapi1
 set cf=%usercflags%
 goto chkapi2
+
 :chkapi1
 set cf=%usercflags% -mno-cygwin
+
 :chkapi2
 echo on
 gcc %cf% -c junk.c
@@ -357,10 +386,12 @@
 set mf=-mcpu=i686
 rm -f junk.c junk.o
 goto gccdebug
+
 :gccMtuneOk
 echo GCC supports -mtune=pentium4 >>config.log
 set mf=-mtune=pentium4
 rm -f junk.c junk.o
+
 :gccdebug
 rem Check for DWARF-2 debug info support, else default to stabs
 echo main(){} >junk.c
@@ -372,6 +403,7 @@
 set dbginfo=-gstabs+
 rm -f junk.c junk.o
 goto compilercheckdone
+
 :gccdwarf
 echo GCC supports DWARF-2 >>config.log
 set dbginfo=-gdwarf-2 -g3
@@ -565,6 +597,7 @@
 set fileNotFound=
 
 rem ----------------------------------------------------------------------
+
 :genmakefiles
 echo Generating makefiles
 if %COMPILER% == gcc set MAKECMD=gmake
@@ -619,6 +652,7 @@
 if errorlevel 1 goto doCopy
 fc /b paths.h ..\src\epaths.h >nul 2>&1
 if errorlevel 0 goto dontCopy
+
 :doCopy
 copy config.tmp ..\src\config.h
 copy paths.h ..\src\epaths.h
@@ -648,6 +682,7 @@
 if not errorlevel 2 goto doUpdateSubdirs
 fc /b subdirs.el ..\site-lisp\subdirs.el >nul 2>&1
 if not errorlevel 1 goto dontUpdateSubdirs
+
 :doUpdateSubdirs
 if exist ..\site-lisp\subdirs.el del ..\site-lisp\subdirs.el
 copy subdirs.el ..\site-lisp\subdirs.el
@@ -716,6 +751,7 @@
 echo Your environment size is too small.  Please enlarge it and rerun configure.
 echo For example, type "command.com /e:2048" to have 2048 bytes available.
 set $foo$=
+
 :end
 set prefix=
 set nodebug=
--- a/src/ChangeLog	Wed Sep 22 11:54:58 2010 +0900
+++ b/src/ChangeLog	Wed Sep 22 11:56:28 2010 +0900
@@ -10,6 +10,15 @@
 	current display element is a grapheme cluster in bidi-reordered
 	region.
 
+2010-09-21  Ari Roponen  <ari.roponen@gmail.com>  (tiny change)
+
+	* doc.c (Fsnarf_documentation): Use memmove instead of memcpy as
+	the regions may overlap.
+
+2010-09-21  Juanma Barranquero  <lekktu@gmail.com>
+
+	* makefile.w32-in ($(BLD)/sysdep.$(O)): Update dependencies.
+
 2010-09-21  Dan Nicolaescu  <dann@ics.uci.edu>
 
 	* emacs.c: Do not include sys/ioctl.h, not needed.
--- a/src/doc.c	Wed Sep 22 11:54:58 2010 +0900
+++ b/src/doc.c	Wed Sep 22 11:56:28 2010 +0900
@@ -678,7 +678,7 @@
 	}
       pos += end - buf;
       filled -= end - buf;
-      memcpy (buf, end, filled);
+      memmove (buf, end, filled);
     }
   emacs_close (fd);
   return Qnil;
--- a/src/makefile.w32-in	Wed Sep 22 11:54:58 2010 +0900
+++ b/src/makefile.w32-in	Wed Sep 22 11:56:28 2010 +0900
@@ -1344,7 +1344,6 @@
 	$(EMACS_ROOT)/nt/inc/pwd.h \
 	$(EMACS_ROOT)/nt/inc/unistd.h \
 	$(EMACS_ROOT)/nt/inc/sys/file.h \
-	$(EMACS_ROOT)/nt/inc/sys/ioctl.h \
 	$(EMACS_ROOT)/nt/inc/sys/socket.h \
 	$(EMACS_ROOT)/nt/inc/sys/time.h \
 	$(SRC)/lisp.h \