[Emacs-diffs] /srv/bzr/emacs/trunk r106768: Merge changes made in Gnus trunk.

[Katsumi Yamaoka]

------------------------------------------------------------
revno: 106768
author: Gnus developers <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Wed 2012-01-04 10:49:38 +0000
message:
  Merge changes made in Gnus trunk.
  
  2012-01-04  Julien Danjou  <address@hidden>
   * nnimap.el (nnimap-update-info): Fix an error when all articles UIDs
   change.
  2012-01-04  Lars Magne Ingebrigtsen  <address@hidden>
   * 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  <address@hidden>
   * 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  <address@hidden>
   * gnus-topic.el (gnus-topic-goto-next-group): Don't move point around
   when opening topics (bug#10407).
modified:
  lisp/gnus/ChangeLog
  lisp/gnus/gnus-demon.el
  lisp/gnus/gnus-topic.el
  lisp/gnus/nnimap.el
  lisp/gnus/nntp.el
  lisp/gnus/shr.el

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2011-12-30 02:52:49 +0000
+++ b/lisp/gnus/ChangeLog       2012-01-04 10:49:38 +0000
@@ -1,3 +1,35 @@
+2012-01-04  Julien Danjou  <address@hidden>
+
+       * nnimap.el (nnimap-update-info): Fix an error when all articles UIDs
+       change.
+
+2012-01-04  Lars Magne Ingebrigtsen  <address@hidden>
+
+       * 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  <address@hidden>
+
+       * 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  <address@hidden>
+
+       * gnus-topic.el (gnus-topic-goto-next-group): Don't move point around
+       when opening topics (bug#10407).
+
 2011-12-28  Katsumi Yamaoka  <address@hidden>
 
        * mm-view.el (mm-display-inline-fontify): Add comment.

=== modified file 'lisp/gnus/gnus-demon.el'
--- a/lisp/gnus/gnus-demon.el   2011-02-25 12:53:00 +0000
+++ b/lisp/gnus/gnus-demon.el   2012-01-04 10:49:38 +0000
@@ -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 <address@hidden>
 ;; Keywords: news
@@ -120,8 +120,12 @@
            ;; 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 @@
       (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 ()

=== modified file 'lisp/gnus/gnus-topic.el'
--- a/lisp/gnus/gnus-topic.el   2011-11-25 07:14:48 +0000
+++ b/lisp/gnus/gnus-topic.el   2012-01-04 10:49:38 +0000
@@ -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 <address@hidden>
 ;;     Lars Magne Ingebrigtsen <address@hidden>
@@ -969,12 +969,15 @@
   (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 @@
        (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 @@
 ;;  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."

=== modified file 'lisp/gnus/nnimap.el'
--- a/lisp/gnus/nnimap.el       2011-11-20 02:29:42 +0000
+++ b/lisp/gnus/nnimap.el       2012-01-04 10:49:38 +0000
@@ -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 <address@hidden>
 ;;         Simon Josefsson <address@hidden>
@@ -1273,11 +1273,11 @@
 
 (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 @@
             (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 @@
                        (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)

=== modified file 'lisp/gnus/nntp.el'
--- a/lisp/gnus/nntp.el 2011-12-04 08:02:42 +0000
+++ b/lisp/gnus/nntp.el 2012-01-04 10:49:38 +0000
@@ -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 <address@hidden>
@@ -281,6 +281,7 @@
 
 ;;; 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 @@
 (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 @@
                   (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 @@
     (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)

=== modified file 'lisp/gnus/shr.el'
--- a/lisp/gnus/shr.el  2011-11-23 00:20:17 +0000
+++ b/lisp/gnus/shr.el  2012-01-04 10:49:38 +0000
@@ -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 <address@hidden>
 ;; Keywords: html
@@ -534,33 +534,33 @@
     (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))