From: Gnus developers Date: Sun, 1 May 2011 23:30:18 +0000 (+0000) Subject: Merge changes made in Gnus trunk. X-Git-Tag: emacs-pretest-24.0.90~104^2~275^2~157 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b87f32fc00c8b085e575fdd4f04af716eee599c4;p=emacs.git Merge changes made in Gnus trunk. pop3.el (pop3-open-server): Upgrade opportunistically to STARTTLS. (open-tls-stream): Remove superfluous tls/starttls autoloads. gnus-sum.el (gnus-summary-next-article): Don't bug out if the summary buffer has moved to a different frame. nnimap.el (nnimap-request-article): Use nntp-insert-buffer-substring to get the conversion from unibyte to multibyte buffers to work on Emacs 22. nntp.el (nntp-request-article): Slight clean-up. --- diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index a4327337f87..e933a80199d 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,21 @@ +2011-05-01 Lars Magne Ingebrigtsen + + * pop3.el (pop3-open-server): Upgrade opportunistically to STARTTLS. + (open-tls-stream): Remove superfluous tls/starttls autoloads. + +2011-05-01 Stefan Monnier + + * gnus-sum.el (gnus-summary-next-article): Don't bug out if the summary + buffer has moved to a different frame. + +2011-05-01 Lars Magne Ingebrigtsen + + * nnimap.el (nnimap-request-article): Use nntp-insert-buffer-substring + to get the conversion from unibyte to multibyte buffers to work on + Emacs 22. + + * nntp.el (nntp-request-article): Slight clean-up. + 2011-04-29 Lars Magne Ingebrigtsen * shr.el (shr-strike-through): New face. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 807f133e481..3cbb479e068 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -7783,7 +7783,8 @@ If BACKWARD, the previous article is selected instead of the next." ;; Somehow or other, we may now have selected a different ;; window. Make point go back to the summary buffer. (when (eq current-summary (current-buffer)) - (select-window (get-buffer-window current-summary))) + ;; FIXME: This burps when get-buffer-window returns nil. + (select-window (get-buffer-window current-summary 0))) (gnus-summary-walk-group-buffer gnus-newsgroup-name cmd unread backward point)))))))) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index f819c17afe8..681d483b462 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -545,10 +545,9 @@ textual parts.") (nnimap-get-whole-article article)) (let ((buffer (current-buffer))) (with-current-buffer (or to-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring buffer) - (nnheader-ms-strip-cr) - (cons group article))))))))) + (nntp-insert-buffer-substring buffer) + (nnheader-ms-strip-cr))) + (cons group article))))))) (deffoo nnimap-request-head (article &optional group server to-buffer) (when (nnimap-possibly-change-group group server) diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 3285da513e8..c8f1d04d4d3 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -1028,16 +1028,15 @@ command whose response triggered the error." (deffoo nntp-request-article (article &optional group server buffer command) (nntp-with-open-group - group server + group server (when (nntp-send-command-and-decode "\r?\n\\.\r?\n" "ARTICLE" (if (numberp article) (int-to-string article) article)) - (if (and buffer - (not (equal buffer nntp-server-buffer))) - (with-current-buffer nntp-server-buffer - (copy-to-buffer buffer (point-min) (point-max)) - (nntp-find-group-and-number group)) - (nntp-find-group-and-number group))))) + (when (and buffer + (not (equal buffer nntp-server-buffer))) + (with-current-buffer nntp-server-buffer + (copy-to-buffer buffer (point-min) (point-max)))) + (nntp-find-group-and-number group)))) (deffoo nntp-request-head (article &optional group server) (nntp-with-open-group diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el index 08cd7cd4ef1..3ca5cab76e1 100644 --- a/lisp/gnus/pop3.el +++ b/lisp/gnus/pop3.el @@ -33,6 +33,13 @@ ;;; Code: (eval-when-compile (require 'cl)) + +(eval-and-compile + ;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for + ;; `make-network-stream'. + (unless (fboundp 'open-protocol-stream) + (require 'proto-stream))) + (require 'mail-utils) (defvar parse-time-months) @@ -257,10 +264,6 @@ Use streaming commands." (pop3-quit process) message-count)) -(autoload 'open-tls-stream "tls") -(autoload 'starttls-open-stream "starttls") -(autoload 'starttls-negotiate "starttls") ; avoid warning - (defcustom pop3-stream-type nil "*Transport security type for POP3 connexions. This may be either nil (plain connexion), `ssl' (use an @@ -286,64 +289,37 @@ this is nil, `ssl' is assumed for connexions to port Returns the process associated with the connection." (let ((coding-system-for-read 'binary) (coding-system-for-write 'binary) - process) + result) (with-current-buffer (get-buffer-create (concat " trace of POP session to " mailhost)) (erase-buffer) (setq pop3-read-point (point-min)) - (setq process - (cond - ((or (eq pop3-stream-type 'ssl) - (and (not pop3-stream-type) (member port '(995 "pop3s")))) - ;; gnutls-cli, openssl don't accept service names - (if (or (equal port "pop3s") - (null port)) - (setq port 995)) - (let ((process (open-tls-stream "POP" (current-buffer) - mailhost port))) - (when process - ;; There's a load of info printed that needs deleting. - (let ((again 't)) - ;; repeat until - ;; - either we received the +OK line - ;; - or accept-process-output timed out without getting - ;; anything - (while (and again - (setq again (memq (process-status process) - '(open run)))) - (setq again (pop3-accept-process-output process)) - (goto-char (point-max)) - (forward-line -1) - (cond ((looking-at "\\+OK") - (setq again nil) - (delete-region (point-min) (point))) - ((not again) - (pop3-quit process) - (error "POP SSL connexion failed"))))) - process))) - ((eq pop3-stream-type 'starttls) - ;; gnutls-cli, openssl don't accept service names - (if (equal port "pop3") - (setq port 110)) - ;; Delay STLS until server greeting is read (Bug#7438). - (starttls-open-stream "POP" (current-buffer) - mailhost (or port 110))) - (t - (open-network-stream "POP" (current-buffer) mailhost port)))) - (let ((response (pop3-read-response process t))) - (setq pop3-timestamp - (substring response (or (string-match "<" response) 0) - (+ 1 (or (string-match ">" response) -1))))) - (when (eq pop3-stream-type 'starttls) - (pop3-send-command process "STLS") - (let ((response (pop3-read-response process t))) - (if (and response (string-match "+OK" response)) - (starttls-negotiate process) - (pop3-quit process) - (error "POP server doesn't support starttls")))) - (pop3-set-process-query-on-exit-flag process nil) - process))) + (setq result + (open-protocol-stream + "POP" (current-buffer) mailhost port + :type (cond + ((or (eq pop3-stream-type 'ssl) + (and (not pop3-stream-type) + (member port '(995 "pop3s")))) + :tls) + (t + (or pop3-stream-type 'network))) + :capability-command "CAPA\r\n" + :end-of-command "^\\.\r?\n\\|^\\+[A-Z]+ .*\n" + :success "^\\+OK.*\n" + :return-list t + :starttls-function + (lambda (capabilities) + (and (string-match "\\bSTLS\\b" capabilities) + "STLS\r\n")))) + (when result + (let ((response (plist-get (cdr result) :greeting))) + (setq pop3-timestamp + (substring response (or (string-match "<" response) 0) + (+ 1 (or (string-match ">" response) -1))))) + (pop3-set-process-query-on-exit-flag (car result) nil) + (car result))))) ;; Support functions