From: Gnus developers Date: Wed, 4 Jan 2012 10:49:38 +0000 (+0000) Subject: Merge changes made in Gnus trunk. X-Git-Tag: emacs-pretest-24.0.93~97^2~55^2~52 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=7e67562fca9c1ca1b6e565c4b440984213629809;p=emacs.git Merge changes made in Gnus trunk. 2012-01-04 Julien Danjou * nnimap.el (nnimap-update-info): Fix an error when all articles UIDs change. 2012-01-04 Lars Magne Ingebrigtsen * 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 * 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 * gnus-topic.el (gnus-topic-goto-next-group): Don't move point around when opening topics (bug#10407). --- diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index a6e88088ee4..34f914a8b0a 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,35 @@ +2012-01-04 Julien Danjou + + * nnimap.el (nnimap-update-info): Fix an error when all articles UIDs + change. + +2012-01-04 Lars Magne Ingebrigtsen + + * 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 + + * 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 + + * gnus-topic.el (gnus-topic-goto-next-group): Don't move point around + when opening topics (bug#10407). + 2011-12-28 Katsumi Yamaoka * mm-view.el (mm-display-inline-fontify): Add comment. diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el index 419346b7191..2f9952241aa 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 ;; 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 87ca27adcf4..0c6c2d36f83 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 ;; Lars Magne Ingebrigtsen @@ -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 b4e6e31fae4..0b0fc918c87 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 ;; Simon Josefsson @@ -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 f4b8ce66d16..e089dfbe106 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 @@ -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 f2d8f843564..d4d8f7dd31e 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 ;; 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))