Merge changes made in Gnus trunk.

2012-01-04  Julien Danjou  <[email protected]>
 * nnimap.el (nnimap-update-info): Fix an error when all articles UIDs
 change.
2012-01-04  Lars Magne Ingebrigtsen  <[email protected]>
 * shr.el (shr-rescale-image): Add :ascent 100 to the rescaled picture,
 too.
 * nntp.el (nntp-retrieve-group-data-early): Use it.
2012-01-03  Lars Magne Ingebrigtsen  <[email protected]>
 * nntp.el (nntp-retrieval-in-progress): New variable.
 (nntp-make-process-buffer): Make it buffer-local.
 * gnus-demon.el (gnus-demon-time-to-step): Resurrect function lost in
 2010.
 (gnus-demon-init): Use it to compute the time if time is on the form
 "04:23".
 * gnus-topic.el (gnus-topic-history): Define `gnus-topic-history'.
 * nnimap.el (nnimap-finish-retrieve-group-infos): Check the connection
 status in the correct buffer.
2012-01-03  Leo  <[email protected]>
 * gnus-topic.el (gnus-topic-goto-next-group): Don't move point around
 when opening topics (bug#10407).

6 files changed, 145 insertions, 57 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index a6e88088ee..34f914a8b0 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,35 @@
+2012-01-04  Julien Danjou  <[email protected]>
+
+	* nnimap.el (nnimap-update-info): Fix an error when all articles UIDs
+	change.
+
+2012-01-04  Lars Magne Ingebrigtsen  <[email protected]>
+
+	* shr.el (shr-rescale-image): Add :ascent 100 to the rescaled picture,
+	too.
+
+	* nntp.el (nntp-retrieve-group-data-early): Use it.
+
+2012-01-03  Lars Magne Ingebrigtsen  <[email protected]>
+
+	* nntp.el (nntp-retrieval-in-progress): New variable.
+	(nntp-make-process-buffer): Make it buffer-local.
+
+	* gnus-demon.el (gnus-demon-time-to-step): Resurrect function lost in
+	2010.
+	(gnus-demon-init): Use it to compute the time if time is on the form
+	"04:23".
+
+	* gnus-topic.el (gnus-topic-history): Define `gnus-topic-history'.
+
+	* nnimap.el (nnimap-finish-retrieve-group-infos): Check the connection
+	status in the correct buffer.
+
+2012-01-03  Leo  <[email protected]>
+
+	* gnus-topic.el (gnus-topic-goto-next-group): Don't move point around
+	when opening topics (bug#10407).
+
 2011-12-28  Katsumi Yamaoka  <[email protected]>
 
 	* mm-view.el (mm-display-inline-fontify): Add comment.
diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el
index 419346b719..2f9952241a 100644
--- a/lisp/gnus/gnus-demon.el
+++ b/lisp/gnus/gnus-demon.el
@@ -1,6 +1,6 @@
 ;;; gnus-demon.el --- daemonic Gnus behavior
 
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <[email protected]>
 ;; Keywords: news
@@ -120,8 +120,12 @@ Emacs has been idle for IDLE `gnus-demon-timestep's."
            ;; If t, replace by 1
            (time (cond ((eq time t)
                         gnus-demon-timestep)
-                       ((null time) nil)
-                       (t (* time gnus-demon-timestep))))
+                       ((null time)
+			nil)
+		       ((stringp time)
+			(gnus-demon-time-to-step time))
+                       (t
+			(* time gnus-demon-timestep))))
            (timer
             (cond
              ;; (func number t)
@@ -144,6 +148,38 @@ Emacs has been idle for IDLE `gnus-demon-timestep's."
       (when timer
         (add-to-list 'gnus-demon-timers timer)))))
 
+(defun gnus-demon-time-to-step (time)
+  "Find out how many seconds to TIME, which is on the form \"17:43\"."
+  (let* ((now (current-time))
+	 ;; obtain NOW as discrete components -- make a vector for speed
+	 (nowParts (decode-time now))
+	 ;; obtain THEN as discrete components
+	 (thenParts (parse-time-string time))
+	 (thenHour (elt thenParts 2))
+	 (thenMin (elt thenParts 1))
+	 ;; convert time as elements into number of seconds since EPOCH.
+	 (then (encode-time 0
+			    thenMin
+			    thenHour
+			    ;; If THEN is earlier than NOW, make it
+			    ;; same time tomorrow.  Doc for encode-time
+			    ;; says that this is OK.
+			    (+ (elt nowParts 3)
+			       (if (or (< thenHour (elt nowParts 2))
+				       (and (= thenHour (elt nowParts 2))
+					    (<= thenMin (elt nowParts 1))))
+				   1 0))
+			    (elt nowParts 4)
+			    (elt nowParts 5)
+			    (elt nowParts 6)
+			    (elt nowParts 7)
+			    (elt nowParts 8)))
+	 ;; calculate number of seconds between NOW and THEN
+	 (diff (+ (* 65536 (- (car then) (car now)))
+		  (- (cadr then) (cadr now)))))
+    ;; return number of timesteps in the number of seconds
+    (round (/ diff gnus-demon-timestep))))
+
 (gnus-add-shutdown 'gnus-demon-cancel 'gnus)
 
 (defun gnus-demon-cancel ()
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index 87ca27adcf..0c6c2d36f8 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -1,6 +1,6 @@
 ;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
 
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
 
 ;; Author: Ilja Weis <[email protected]>
 ;;	Lars Magne Ingebrigtsen <[email protected]>
@@ -969,12 +969,15 @@ articles in the topic and its subtopics."
   (if (not group)
       (if (not (memq 'gnus-topic props))
 	  (goto-char (point-max))
-	(gnus-topic-goto-topic (symbol-name (cadr (memq 'gnus-topic props)))))
+	(let ((topic (symbol-name (cadr (memq 'gnus-topic props)))))
+	  (or (gnus-topic-goto-topic topic)
+	      (gnus-topic-goto-topic (gnus-topic-next-topic topic)))))
     (if (gnus-group-goto-group group)
 	t
       ;; The group is no longer visible.
       (let* ((list (assoc (gnus-group-topic group) gnus-topic-alist))
-	     (after (cdr (member group (cdr list)))))
+	     (topic-visible (save-excursion (gnus-topic-goto-topic (car list))))
+	     (after (and topic-visible (cdr (member group (cdr list))))))
 	;; First try to put point on a group after the current one.
 	(while (and after
 		    (not (gnus-group-goto-group (car after))))
@@ -989,7 +992,9 @@ articles in the topic and its subtopics."
 	(if (not (car list))
 	    (goto-char (point-min))
 	  (unless after
-	    (gnus-topic-goto-topic (car list))
+	    (if topic-visible
+		(gnus-goto-char topic-visible)
+	      (gnus-topic-goto-topic (gnus-topic-next-topic (car list))))
 	    (setq after nil)))
 	t))))
 
@@ -1297,6 +1302,8 @@ When used interactively, PARENT will be the topic under point."
 ;;  2. Can't process on several marked groups with a same name,
 ;;     because gnus-group-marked only keeps one copy.
 
+(defvar gnus-topic-history nil)
+
 (defun gnus-topic-move-group (n topic &optional copyp)
   "Move the next N groups to TOPIC.
 If COPYP, copy the groups instead."
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index b4e6e31fae..0b0fc918c8 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1,6 +1,6 @@
 ;;; nnimap.el --- IMAP interface for Gnus
 
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <[email protected]>
 ;;         Simon Josefsson <[email protected]>
@@ -1273,11 +1273,11 @@ textual parts.")
 
 (deffoo nnimap-finish-retrieve-group-infos (server infos sequences)
   (when (and sequences
+	     (nnimap-possibly-change-group nil server)
 	     ;; Check that the process is still alive.
 	     (get-buffer-process (nnimap-buffer))
 	     (memq (process-status (get-buffer-process (nnimap-buffer)))
-		   '(open run))
-	     (nnimap-possibly-change-group nil server))
+		   '(open run)))
     (with-current-buffer (nnimap-buffer)
       ;; Wait for the final data to trickle in.
       (when (nnimap-wait-for-response (if (eq (cadar sequences) 'qresync)
@@ -1332,7 +1332,8 @@ textual parts.")
 	     (cdr (assq 'uidvalidity (gnus-info-params info)))))
 	(and old-uidvalidity
 	     (not (equal old-uidvalidity uidvalidity))
-	     (> start-article 1)))
+             (or (not start-article)
+                 (> start-article 1))))
       (gnus-group-remove-parameter info 'uidvalidity)
       (gnus-group-remove-parameter info 'modseq))
      ;; We have the data needed to update.
@@ -1620,8 +1621,9 @@ textual parts.")
                        (nnimap-command  "UID SEARCH %s" cmd))))
         (when result
           (gnus-fetch-headers
-           (and (car result) (delete 0 (mapcar #'string-to-number
-                                               (cdr (assoc "SEARCH" (cdr result))))))
+           (and (car result)
+		(delete 0 (mapcar #'string-to-number
+				  (cdr (assoc "SEARCH" (cdr result))))))
            nil t))))))
 
 (defun nnimap-possibly-change-group (group server)
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index f4b8ce66d1..e089dfbe10 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -1,6 +1,6 @@
 ;;; nntp.el --- nntp access for Gnus
 
-;; Copyright (C) 1987-1990, 1992-1998, 2000-2011
+;; Copyright (C) 1987-1990, 1992-1998, 2000-2012
 ;;   Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <[email protected]>
@@ -281,6 +281,7 @@ update their active files often, this can help.")
 
 ;;; Internal variables.
 
+(defvoo nntp-retrieval-in-progress nil)
 (defvar nntp-record-commands nil
   "*If non-nil, nntp will record all commands in the \"*nntp-log*\" buffer.")
 
@@ -770,21 +771,28 @@ command whose response triggered the error."
 (deffoo nntp-retrieve-group-data-early (server infos)
   "Retrieve group info on INFOS."
   (nntp-with-open-group nil server
-    (when (nntp-find-connection-buffer nntp-server-buffer)
-      ;; The first time this is run, this variable is `try'.  So we
-      ;; try.
-      (when (eq nntp-server-list-active-group 'try)
-	(nntp-try-list-active
-	 (gnus-group-real-name (gnus-info-group (car infos)))))
-      (with-current-buffer (nntp-find-connection-buffer nntp-server-buffer)
-	(erase-buffer)
-	(let ((nntp-inhibit-erase t)
-	      (command (if nntp-server-list-active-group
-			   "LIST ACTIVE" "GROUP")))
-	  (dolist (info infos)
-	    (nntp-send-command
-	     nil command (gnus-group-real-name (gnus-info-group info)))))
-	(length infos)))))
+    (let ((buffer (nntp-find-connection-buffer nntp-server-buffer)))
+      (when (and buffer
+		 (with-current-buffer buffer
+		   (not nntp-retrieval-in-progress)))
+	;; The first time this is run, this variable is `try'.  So we
+	;; try.
+	(when (eq nntp-server-list-active-group 'try)
+	  (nntp-try-list-active
+	   (gnus-group-real-name (gnus-info-group (car infos)))))
+	(with-current-buffer buffer
+	  (erase-buffer)
+	  ;; Mark this buffer as "in use" in case we try to issue two
+	  ;; retrievals from the same server.  This shouldn't happen,
+	  ;; so this is mostly a sanity check.
+	  (setq nntp-retrieval-in-progress t)
+	  (let ((nntp-inhibit-erase t)
+		(command (if nntp-server-list-active-group
+			     "LIST ACTIVE" "GROUP")))
+	    (dolist (info infos)
+	      (nntp-send-command
+	       nil command (gnus-group-real-name (gnus-info-group info)))))
+	  (length infos))))))
 
 (deffoo nntp-finish-retrieve-group-infos (server infos count)
   (nntp-with-open-group nil server
@@ -794,6 +802,8 @@ command whose response triggered the error."
 		   (car infos)))
 	  (received 0)
 	  (last-point 1))
+      (with-current-buffer buf
+	(setq nntp-retrieval-in-progress nil))
       (when (and buf
 		 count)
 	(with-current-buffer buf
@@ -1318,6 +1328,7 @@ password contained in '~/.nntp-authinfo'."
     (set (make-local-variable 'nntp-process-to-buffer) nil)
     (set (make-local-variable 'nntp-process-start-point) nil)
     (set (make-local-variable 'nntp-process-decode) nil)
+    (set (make-local-variable 'nntp-retrieval-in-progress) nil)
     (current-buffer)))
 
 (defun nntp-open-connection (buffer)
diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el
index f2d8f84356..d4d8f7dd31 100644
--- a/lisp/gnus/shr.el
+++ b/lisp/gnus/shr.el
@@ -1,6 +1,6 @@
 ;;; shr.el --- Simple HTML Renderer
 
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <[email protected]>
 ;; Keywords: html
@@ -534,33 +534,33 @@ the URL of the image to the kill buffer instead."
     (insert alt)))
 
 (defun shr-rescale-image (data)
-  (if (or (not (fboundp 'imagemagick-types))
-	  (not (get-buffer-window (current-buffer))))
-      (create-image data nil t
-		    :ascent 100)
-    (let* ((image (create-image data nil t :ascent 100))
-	   (size (image-size image t))
-	   (width (car size))
-	   (height (cdr size))
-	   (edges (window-inside-pixel-edges
-		   (get-buffer-window (current-buffer))))
-	   (window-width (truncate (* shr-max-image-proportion
-				      (- (nth 2 edges) (nth 0 edges)))))
-	   (window-height (truncate (* shr-max-image-proportion
-				       (- (nth 3 edges) (nth 1 edges)))))
-	   scaled-image)
-      (when (> height window-height)
-	(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 data 'imagemagick t
-				   :width window-width
-				   :ascent 100)
-		     image)))
-      image)))
+  (let ((image (create-image data nil t :ascent 100)))
+    (if (or (not (fboundp 'imagemagick-types))
+	    (not (get-buffer-window (current-buffer))))
+	image
+      (let* ((size (image-size image t))
+	     (width (car size))
+	     (height (cdr size))
+	     (edges (window-inside-pixel-edges
+		     (get-buffer-window (current-buffer))))
+	     (window-width (truncate (* shr-max-image-proportion
+					(- (nth 2 edges) (nth 0 edges)))))
+	     (window-height (truncate (* shr-max-image-proportion
+					 (- (nth 3 edges) (nth 1 edges)))))
+	     scaled-image)
+	(when (> height window-height)
+	  (setq image (or (create-image data 'imagemagick t
+					:height window-height
+					:ascent 100)
+			  image))
+	  (setq size (image-size image t)))
+	(when (> (car size) window-width)
+	  (setq image (or
+		       (create-image data 'imagemagick t
+				     :width window-width
+				     :ascent 100)
+		       image)))
+	image))))
 
 ;; url-cache-extract autoloads url-cache.
 (declare-function url-cache-create-filename "url-cache" (url))