Split -request-update-info into -request-marks and -update-info.
[gnus] / lisp / nntp.el
index 46294af..1bf2ce1 100644 (file)
@@ -2,41 +2,46 @@
 
 ;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993,
 ;;   1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002,
-;;   2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+;;   2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation; either version 2, or (at your
-;; option) any later version.
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
-;; GNU Emacs is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; General Public License for more details.
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,
-;; MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 ;;; Code:
 
+;; For Emacs < 22.2.
+(eval-and-compile
+  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+
 (require 'nnheader)
 (require 'nnoo)
 (require 'gnus-util)
 (require 'gnus)
+(require 'gnus-group) ;; gnus-group-name-charset
 
 (nnoo-declare nntp)
 
 (eval-when-compile (require 'cl))
 
+(autoload 'auth-source-user-or-password "auth-source")
+
 (defgroup nntp nil
   "NNTP access for Gnus."
   :group 'gnus)
@@ -83,13 +88,29 @@ Direct connections:
 - `nntp-open-network-stream' (the default),
 - `nntp-open-ssl-stream',
 - `nntp-open-tls-stream',
+- `nntp-open-netcat-stream'.
 - `nntp-open-telnet-stream'.
 
 Indirect connections:
-- `nntp-open-via-rlogin-and-telnet',
 - `nntp-open-via-rlogin-and-netcat',
+- `nntp-open-via-rlogin-and-telnet',
 - `nntp-open-via-telnet-and-telnet'.")
 
+(defvoo nntp-never-echoes-commands nil
+  "*Non-nil means the nntp server never echoes commands.
+It is reported that some nntps server doesn't echo commands.  So, you
+may want to set this to non-nil in the method for such a server setting
+`nntp-open-connection-function' to `nntp-open-ssl-stream' for example.
+Note that the `nntp-open-connection-functions-never-echo-commands'
+variable overrides the nil value of this variable.")
+
+(defvoo nntp-open-connection-functions-never-echo-commands
+    '(nntp-open-network-stream)
+  "*List of functions that never echo commands.
+Add or set a function which you set to `nntp-open-connection-function'
+to this list if it does not echo commands.  Note that a non-nil value
+of the `nntp-never-echoes-commands' variable overrides this variable.")
+
 (defvoo nntp-pre-command nil
   "*Pre-command to use with the various nntp-open-via-* methods.
 This is where you would put \"runsocks\" or stuff like that.")
@@ -127,12 +148,13 @@ This command is used by the `nntp-open-via-telnet-and-telnet' method.")
 (defvoo nntp-via-telnet-switches '("-8")
   "*Switches given to the telnet command `nntp-via-telnet-command'.")
 
-(defvoo nntp-via-netcat-command "nc"
+(defvoo nntp-netcat-command "nc"
   "*Netcat command used to connect to the nntp server.
-This command is used by the `nntp-open-via-rlogin-and-netcat' method.")
+This command is used by the `nntp-open-netcat-stream' and
+`nntp-open-via-rlogin-and-netcat' methods.")
 
-(defvoo nntp-via-netcat-switches nil
-  "*Switches given to the netcat command `nntp-via-netcat-command'.")
+(defvoo nntp-netcat-switches nil
+  "*Switches given to the netcat command `nntp-netcat-command'.")
 
 (defvoo nntp-via-user-name nil
   "*User name to log in on an intermediate host with.
@@ -178,6 +200,14 @@ by one.")
 If the gap between two consecutive articles is bigger than this
 variable, split the XOVER request into two requests.")
 
+(defvoo nntp-xref-number-is-evil nil
+  "*If non-nil, Gnus never trusts article numbers in the Xref header.
+Some news servers, e.g., ones running Diablo, run multiple engines
+having the same articles but article numbers are not kept synchronized
+between them.  If you connect to such a server, set this to a non-nil
+value, and Gnus never uses article numbers (that appear in the Xref
+header and vary by which engine is chosen) to refer to articles.")
+
 (defvoo nntp-prepare-server-hook nil
   "*Hook run before a server is opened.
 If can be used to set up a server remotely, for instance.  Say you
@@ -254,6 +284,7 @@ to insert Cancel-Lock headers.")
 (defvoo nntp-last-command nil)
 (defvoo nntp-authinfo-password nil)
 (defvoo nntp-authinfo-user nil)
+(defvoo nntp-authinfo-force nil)
 
 (defvar nntp-connection-list nil)
 
@@ -267,13 +298,6 @@ to insert Cancel-Lock headers.")
 (defvoo nntp-server-xover 'try)
 (defvoo nntp-server-list-active-group 'try)
 
-(defvar nntp-async-needs-kluge
-  (string-match "^GNU Emacs 20\\.3\\." (emacs-version))
-  "*When non-nil, nntp will poll asynchronous connections
-once a second.  By default, this is turned on only for Emacs
-20.3, which has a bug that breaks nntp's normal method of
-noticing asynchronous data.")
-
 (defvar nntp-async-timer nil)
 (defvar nntp-async-process-list nil)
 
@@ -285,8 +309,8 @@ port number on server.  The program should accept IMAP commands on
 stdin and return responses to stdout.")
 
 (defvar nntp-authinfo-rejected nil
-"A custom error condition used to report 'Authentication Rejected' errors.  
-Condition handlers that match just this condition ensure that the nntp 
+"A custom error condition used to report 'Authentication Rejected' errors.
+Condition handlers that match just this condition ensure that the nntp
 backend doesn't catch this error.")
 (put 'nntp-authinfo-rejected 'error-conditions '(error nntp-authinfo-rejected))
 (put 'nntp-authinfo-rejected 'error-message "Authorization Rejected")
@@ -310,8 +334,7 @@ backend doesn't catch this error.")
 
 (defun nntp-record-command (string)
   "Record the command STRING."
-  (save-excursion
-    (set-buffer (get-buffer-create "*nntp-log*"))
+  (with-current-buffer (get-buffer-create "*nntp-log*")
     (goto-char (point-max))
     (let ((time (current-time)))
       (insert (format-time-string "%Y%m%dT%H%M%S" time)
@@ -339,11 +362,36 @@ be restored and the command retried."
 
   (throw 'nntp-with-open-group-error t))
 
+(defmacro nntp-insert-buffer-substring (buffer &optional start end)
+  "Copy string from unibyte buffer to multibyte current buffer."
+  (if (featurep 'xemacs)
+      `(insert-buffer-substring ,buffer ,start ,end)
+    `(if enable-multibyte-characters
+        (insert (with-current-buffer ,buffer
+                  (mm-string-to-multibyte
+                   ,(if (or start end)
+                        `(buffer-substring (or ,start (point-min))
+                                           (or ,end (point-max)))
+                      '(buffer-string)))))
+       (insert-buffer-substring ,buffer ,start ,end))))
+
+(defmacro nntp-copy-to-buffer (buffer start end)
+  "Copy string from unibyte current buffer to multibyte buffer."
+  (if (featurep 'xemacs)
+      `(copy-to-buffer ,buffer ,start ,end)
+    `(let ((string (buffer-substring ,start ,end)))
+       (with-current-buffer ,buffer
+        (erase-buffer)
+        (insert (if enable-multibyte-characters
+                    (mm-string-to-multibyte string)
+                  string))
+        (goto-char (point-min))
+        nil))))
+
 (defsubst nntp-wait-for (process wait-for buffer &optional decode discard)
   "Wait for WAIT-FOR to arrive from PROCESS."
 
-  (save-excursion
-    (set-buffer (process-buffer process))
+  (with-current-buffer (process-buffer process)
     (goto-char (point-min))
 
     (while (and (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5)))
@@ -381,10 +429,9 @@ be restored and the command retried."
              (setq nntp-process-response response)))
          (nntp-decode-text (not decode))
          (unless discard
-           (save-excursion
-             (set-buffer buffer)
+           (with-current-buffer buffer
              (goto-char (point-max))
-             (insert-buffer-substring (process-buffer process))
+             (nntp-insert-buffer-substring (process-buffer process))
              ;; Nix out "nntp reading...." message.
              (when nntp-have-messaged
                (setq nntp-have-messaged nil)
@@ -478,19 +525,21 @@ be restored and the command retried."
                                nntp-server-buffer
                                wait-for nnheader-callback-function)
          ;; If nothing to wait for, still remove possibly echo'ed commands.
-         ;; We don't have echos if nntp-open-connection-function
-         ;; is `nntp-open-network-stream', so we skip this in that case.
+         ;; We don't have echoes if `nntp-never-echoes-commands' is non-nil
+         ;; or the value of `nntp-open-connection-function' is in
+         ;; `nntp-open-connection-functions-never-echo-commands', so we
+         ;; skip this in that cases.
          (unless (or wait-for
-                     (equal nntp-open-connection-function
-                            'nntp-open-network-stream))
+                     nntp-never-echoes-commands
+                     (memq
+                      nntp-open-connection-function
+                      nntp-open-connection-functions-never-echo-commands))
            (nntp-accept-response)
-           (save-excursion
-             (set-buffer buffer)
+           (with-current-buffer buffer
              (goto-char pos)
              (if (looking-at (regexp-quote command))
                  (delete-region pos (progn (forward-line 1)
-                                           (point-at-bol))))
-             )))
+                                           (point-at-bol)))))))
       (nnheader-report 'nntp "Couldn't open connection to %s."
                       nntp-address))))
 
@@ -509,8 +558,7 @@ be restored and the command retried."
          ;; If nothing to wait for, still remove possibly echo'ed commands
          (unless wait-for
            (nntp-accept-response)
-           (save-excursion
-             (set-buffer buffer)
+           (with-current-buffer buffer
              (goto-char pos)
              (if (looking-at (regexp-quote command))
                  (delete-region pos (progn (forward-line 1)
@@ -536,8 +584,7 @@ be restored and the command retried."
          ;; If nothing to wait for, still remove possibly echo'ed commands
          (unless wait-for
            (nntp-accept-response)
-           (save-excursion
-             (set-buffer buffer)
+           (with-current-buffer buffer
              (goto-char pos)
              (if (looking-at (regexp-quote command))
                  (delete-region pos (progn (forward-line 1) (point-at-bol))))
@@ -553,10 +600,12 @@ be restored and the command retried."
     (nntp-erase-buffer
      (nntp-find-connection-buffer nntp-server-buffer)))
   (nntp-encode-text)
-  (mm-with-unibyte-current-buffer
-    ;; Some encoded unicode text contains character 0x80-0x9f e.g. Euro.
-    (process-send-region (nntp-find-connection nntp-server-buffer)
-                        (point-min) (point-max)))
+  ;; Make sure we did not forget to encode some of the content.
+  (assert (save-excursion (goto-char (point-min))
+                          (not (re-search-forward "[^\000-\377]" nil t))))
+  (mm-disable-multibyte)
+  (process-send-region (nntp-find-connection nntp-server-buffer)
+                       (point-min) (point-max))
   (nntp-retrieve-data
    nil nntp-address nntp-port-number nntp-server-buffer
    wait-for nnheader-callback-function))
@@ -594,67 +643,79 @@ be restored and the command retried."
   (defvar nntp-with-open-group-internal nil)
   (defvar nntp-report-n nil))
 
+(defun nntp-with-open-group-function (-group -server -connectionless -bodyfun)
+  "Protect against servers that don't like clients that keep idle connections opens.
+The problem being that these servers may either close a connection or
+simply ignore any further requests on a connection.  Closed
+connections are not detected until `accept-process-output' has updated
+the `process-status'.  Dropped connections are not detected until the
+connection timeouts (which may be several minutes) or
+`nntp-connection-timeout' has expired.  When these occur
+`nntp-with-open-group', opens a new connection then re-issues the NNTP
+command whose response triggered the error."
+  (letf ((nntp-report-n (symbol-function 'nntp-report))
+         ((symbol-function 'nntp-report) (symbol-function 'nntp-report-1))
+         (nntp-with-open-group-internal nil))
+    (while (catch 'nntp-with-open-group-error
+             ;; Open the connection to the server
+             ;; NOTE: Existing connections are NOT tested.
+             (nntp-possibly-change-group -group -server -connectionless)
+
+             (let ((-timer
+                    (and nntp-connection-timeout
+                         (run-at-time
+                          nntp-connection-timeout nil
+                          (lambda ()
+                            (let* ((-process (nntp-find-connection
+                                             nntp-server-buffer))
+                                   (-buffer  (and -process
+                                                  (process-buffer -process))))
+                              ;; When I an able to identify the
+                              ;; connection to the server AND I've
+                              ;; received NO reponse for
+                              ;; nntp-connection-timeout seconds.
+                              (when (and -buffer (eq 0 (buffer-size -buffer)))
+                                ;; Close the connection.  Take no
+                                ;; other action as the accept input
+                                ;; code will handle the closed
+                                ;; connection.
+                                (nntp-kill-buffer -buffer))))))))
+               (unwind-protect
+                   (setq nntp-with-open-group-internal
+                         (condition-case nil
+                             (funcall -bodyfun)
+                           (quit
+                            (unless debug-on-quit
+                              (nntp-close-server))
+                            (signal 'quit nil))))
+                 (when -timer
+                   (nnheader-cancel-timer -timer)))
+               nil))
+      (setf (symbol-function 'nntp-report) nntp-report-n))
+    nntp-with-open-group-internal))
+
 (defmacro nntp-with-open-group (group server &optional connectionless &rest forms)
   "Protect against servers that don't like clients that keep idle connections opens.
 The problem being that these servers may either close a connection or
 simply ignore any further requests on a connection.  Closed
-connections are not detected until accept-process-output has updated
-the process-status.  Dropped connections are not detected until the
+connections are not detected until `accept-process-output' has updated
+the `process-status'.  Dropped connections are not detected until the
 connection timeouts (which may be several minutes) or
-nntp-connection-timeout has expired.  When these occur
-nntp-with-open-group, opens a new connection then re-issues the NNTP
+`nntp-connection-timeout' has expired.  When these occur
+`nntp-with-open-group', opens a new connection then re-issues the NNTP
 command whose response triggered the error."
+  (declare (indent 2) (debug (form form [&optional symbolp] def-body)))
   (when (and (listp connectionless)
             (not (eq connectionless nil)))
     (setq forms (cons connectionless forms)
          connectionless nil))
-  `(letf ((nntp-report-n (symbol-function 'nntp-report))
-         ((symbol-function 'nntp-report) (symbol-function 'nntp-report-1))
-         (nntp-with-open-group-internal nil))
-     (while (catch 'nntp-with-open-group-error
-             ;; Open the connection to the server
-             ;; NOTE: Existing connections are NOT tested.
-             (nntp-possibly-change-group ,group ,server ,connectionless)
-
-             (let ((timer
-                    (and nntp-connection-timeout
-                         (run-at-time
-                          nntp-connection-timeout nil
-                          '(lambda ()
-                             (let ((process (nntp-find-connection
-                                             nntp-server-buffer))
-                                   (buffer  (and process
-                                                 (process-buffer process))))
-                               ;; When I an able to identify the
-                               ;; connection to the server AND I've
-                               ;; received NO reponse for
-                               ;; nntp-connection-timeout seconds.
-                               (when (and buffer (eq 0 (buffer-size buffer)))
-                                 ;; Close the connection.  Take no
-                                 ;; other action as the accept input
-                                 ;; code will handle the closed
-                                 ;; connection.
-                                 (nntp-kill-buffer buffer))))))))
-               (unwind-protect
-                   (setq nntp-with-open-group-internal
-                          (condition-case nil
-                             (progn ,@forms)
-                           (quit
-                            (unless debug-on-quit
-                              (nntp-close-server))
-                             (signal 'quit nil))))
-                 (when timer
-                   (nnheader-cancel-timer timer)))
-               nil))
-       (setf (symbol-function 'nntp-report) nntp-report-n))
-     nntp-with-open-group-internal))
+  `(nntp-with-open-group-function ,group ,server ,connectionless (lambda () ,@forms)))
 
 (deffoo nntp-retrieve-headers (articles &optional group server fetch-old)
   "Retrieve the headers of ARTICLES."
   (nntp-with-open-group
    group server
-   (save-excursion
-     (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
+   (with-current-buffer (nntp-find-connection-buffer nntp-server-buffer)
      (erase-buffer)
      (if (and (not gnus-nov-is-evil)
               (not nntp-nov-is-evil)
@@ -710,7 +771,7 @@ command whose response triggered the error."
          (nnheader-fold-continuation-lines)
          ;; Remove all "\r"'s.
          (nnheader-strip-cr)
-         (copy-to-buffer nntp-server-buffer (point-min) (point-max))
+        (nntp-copy-to-buffer nntp-server-buffer (point-min) (point-max))
          'headers)))))
 
 (deffoo nntp-retrieve-groups (groups &optional server)
@@ -792,7 +853,8 @@ command whose response triggered the error."
 
            (if (not nntp-server-list-active-group)
                (progn
-                 (copy-to-buffer nntp-server-buffer (point-min) (point-max))
+                (nntp-copy-to-buffer nntp-server-buffer
+                                     (point-min) (point-max))
                  'group)
              ;; We have read active entries, so we just delete the
              ;; superfluous gunk.
@@ -800,7 +862,7 @@ command whose response triggered the error."
              (while (re-search-forward "^[.2-5]" nil t)
                (delete-region (match-beginning 0)
                               (progn (forward-line 1) (point))))
-             (copy-to-buffer nntp-server-buffer (point-min) (point-max))
+            (nntp-copy-to-buffer nntp-server-buffer (point-min) (point-max))
              'active)))))))
 
 (deffoo nntp-retrieve-articles (articles &optional group server)
@@ -865,7 +927,7 @@ command whose response triggered the error."
           (narrow-to-region
            (setq point (goto-char (point-max)))
            (progn
-             (insert-buffer-substring buf last-point (cdr entry))
+            (nntp-insert-buffer-substring buf last-point (cdr entry))
              (point-max)))
           (setq last-point (cdr entry))
           (nntp-decode-text)
@@ -875,8 +937,7 @@ command whose response triggered the error."
 
 (defun nntp-try-list-active (group)
   (nntp-list-active-group group)
-  (save-excursion
-    (set-buffer nntp-server-buffer)
+  (with-current-buffer nntp-server-buffer
     (goto-char (point-min))
     (cond ((or (eobp)
               (looking-at "5[0-9]+"))
@@ -904,8 +965,7 @@ command whose response triggered the error."
            (if (numberp article) (int-to-string article) article))
       (if (and buffer
                (not (equal buffer nntp-server-buffer)))
-          (save-excursion
-            (set-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)))))
@@ -927,7 +987,7 @@ command whose response triggered the error."
     "\r?\n\\.\r?\n" "BODY"
     (if (numberp article) (int-to-string article) article))))
 
-(deffoo nntp-request-group (group &optional server dont-check)
+(deffoo nntp-request-group (group &optional server dont-check info)
   (nntp-with-open-group
     nil server
     (when (nntp-send-command "^[245].*\n" "GROUP" group)
@@ -954,7 +1014,8 @@ command whose response triggered the error."
     (unless (assq 'nntp-address defs)
       (setq defs (append defs (list (list 'nntp-address server)))))
     (nnoo-change-server 'nntp server defs)
-    (unless connectionless
+    (if connectionless
+       t
       (or (nntp-find-connection nntp-server-buffer)
          (nntp-open-connection nntp-server-buffer)))))
 
@@ -1002,8 +1063,7 @@ command whose response triggered the error."
 (deffoo nntp-request-newgroups (date &optional server)
   (nntp-with-open-group
    nil server
-   (save-excursion
-     (set-buffer nntp-server-buffer)
+   (with-current-buffer nntp-server-buffer
      (let* ((time (date-to-time date))
             (ls (- (cadr time) (nth 8 (decode-time time)))))
        (cond ((< ls 0)
@@ -1050,7 +1110,8 @@ command whose response triggered the error."
   t)
 
 (deffoo nntp-request-set-mark (group actions &optional server)
-  (unless nntp-marks-is-evil
+  (when (and (not nntp-marks-is-evil)
+            nntp-marks-file-name)
     (nntp-possibly-create-directory group server)
     (nntp-open-marks group server)
     (dolist (action actions)
@@ -1069,8 +1130,9 @@ command whose response triggered the error."
     (nntp-save-marks group server))
   nil)
 
-(deffoo nntp-request-update-info (group info &optional server)
-  (unless nntp-marks-is-evil
+(deffoo nntp-request-marks (group info &optional server)
+  (when (and (not nntp-marks-is-evil)
+            nntp-marks-file-name)
     (nntp-possibly-create-directory group server)
     (when (nntp-marks-changed-p group server)
       (nnheader-message 8 "Updating marks for %s..." group)
@@ -1106,6 +1168,11 @@ It will make innd servers spawn an nnrpd process to allow actual article
 reading."
   (nntp-send-command "^.*\n" "MODE READER"))
 
+(declare-function netrc-parse "netrc" (file))
+(declare-function netrc-machine "netrc"
+                 (list machine &optional port defaultport))
+(declare-function netrc-get "netrc" (alist type))
+
 (defun nntp-send-authinfo (&optional send-if-force)
   "Send the AUTHINFO to the nntp server.
 It will look in the \"~/.authinfo\" file for matching entries.  If
@@ -1114,11 +1181,23 @@ and a password.
 
 If SEND-IF-FORCE, only send authinfo to the server if the
 .authinfo file has the FORCE token."
+  (require 'netrc)
   (let* ((list (netrc-parse nntp-authinfo-file))
         (alist (netrc-machine list nntp-address "nntp"))
-        (force (netrc-get alist "force"))
-        (user (or (netrc-get alist "login") nntp-authinfo-user))
-        (passwd (netrc-get alist "password")))
+        (force (or (netrc-get alist "force") nntp-authinfo-force))
+        (auth-info
+         (auth-source-user-or-password '("login" "password") nntp-address "nntp"))
+        (auth-user (nth 0 auth-info))
+        (auth-passwd (nth 1 auth-info))
+        (user (or
+               ;; this is preferred to netrc-*
+               auth-user
+               (netrc-get alist "login")
+               nntp-authinfo-user))
+        (passwd (or
+                 ;; this is preferred to netrc-*
+                 auth-passwd
+                 (netrc-get alist "password"))))
     (when (or (not send-if-force)
              force)
       (unless user
@@ -1172,13 +1251,12 @@ password contained in '~/.nntp-authinfo'."
 
 (defun nntp-make-process-buffer (buffer)
   "Create a new, fresh buffer usable for nntp process connections."
-  (save-excursion
-    (set-buffer
-     (generate-new-buffer
-      (format " *server %s %s %s*"
-             nntp-address nntp-port-number
-             (gnus-buffer-exists-p buffer))))
-    (mm-enable-multibyte)
+  (with-current-buffer
+      (generate-new-buffer
+       (format " *server %s %s %s*"
+               nntp-address nntp-port-number
+               (gnus-buffer-exists-p buffer)))
+    (mm-disable-multibyte)
     (set (make-local-variable 'after-change-functions) nil)
     (set (make-local-variable 'nntp-process-wait-for) nil)
     (set (make-local-variable 'nntp-process-callback) nil)
@@ -1204,7 +1282,7 @@ password contained in '~/.nntp-authinfo'."
                (funcall nntp-open-connection-function pbuffer))
            (error nil)
            (quit
-            (message "Quit opening connection")
+            (message "Quit opening connection to %s" nntp-address)
             (nntp-kill-buffer pbuffer)
             (signal 'quit nil)
             nil))))
@@ -1220,8 +1298,7 @@ password contained in '~/.nntp-authinfo'."
          (prog1
              (caar (push (list process buffer nil) nntp-connection-alist))
            (push process nntp-connection-list)
-           (save-excursion
-             (set-buffer pbuffer)
+           (with-current-buffer pbuffer
              (nntp-read-server-type)
              (erase-buffer)
              (set-buffer nntp-server-buffer)
@@ -1234,10 +1311,9 @@ password contained in '~/.nntp-authinfo'."
 (defun nntp-open-network-stream (buffer)
   (open-network-stream "nntpd" buffer nntp-address nntp-port-number))
 
-(eval-and-compile
-  (autoload 'format-spec "format-spec")
-  (autoload 'format-spec-make "format-spec")
-  (autoload 'open-tls-stream "tls"))
+(autoload 'format-spec "format-spec")
+(autoload 'format-spec-make "format-spec")
+(autoload 'open-tls-stream "tls")
 
 (defun nntp-open-ssl-stream (buffer)
   (let* ((process-connection-type nil)
@@ -1249,8 +1325,7 @@ password contained in '~/.nntp-authinfo'."
                                            ?s nntp-address
                                            ?p nntp-port-number)))))
     (gnus-set-process-query-on-exit-flag proc nil)
-    (save-excursion
-      (set-buffer buffer)
+    (with-current-buffer buffer
       (let ((nntp-connection-alist (list proc buffer nil)))
        (nntp-wait-for-string "^\r*20[01]"))
       (beginning-of-line)
@@ -1260,8 +1335,7 @@ password contained in '~/.nntp-authinfo'."
 (defun nntp-open-tls-stream (buffer)
   (let ((proc (open-tls-stream "nntpd" buffer nntp-address nntp-port-number)))
     (gnus-set-process-query-on-exit-flag proc nil)
-    (save-excursion
-      (set-buffer buffer)
+    (with-current-buffer buffer
       (let ((nntp-connection-alist (list proc buffer nil)))
        (nntp-wait-for-string "^\r*20[01]"))
       (beginning-of-line)
@@ -1282,8 +1356,7 @@ password contained in '~/.nntp-authinfo'."
          (funcall (cadr entry)))))))
 
 (defun nntp-async-wait (process wait-for buffer decode callback)
-  (save-excursion
-    (set-buffer (process-buffer process))
+  (with-current-buffer (process-buffer process)
     (unless nntp-inside-change-function
       (erase-buffer))
     (setq nntp-process-wait-for wait-for
@@ -1291,17 +1364,7 @@ password contained in '~/.nntp-authinfo'."
          nntp-process-decode decode
          nntp-process-callback callback
          nntp-process-start-point (point-max))
-    (setq after-change-functions '(nntp-after-change-function))
-    (if nntp-async-needs-kluge
-       (nntp-async-kluge process))))
-
-(defun nntp-async-kluge (process)
-  ;; emacs 20.3 bug: process output with encoding 'binary
-  ;; doesn't trigger after-change-functions.
-  (unless nntp-async-timer
-    (setq nntp-async-timer
-         (run-at-time 1 1 'nntp-async-timer-handler)))
-  (add-to-list 'nntp-async-process-list process))
+    (setq after-change-functions '(nntp-after-change-function))))
 
 (defun nntp-async-timer-handler ()
   (mapcar
@@ -1331,8 +1394,7 @@ password contained in '~/.nntp-authinfo'."
       (setq after-change-functions '(nntp-after-change-function)))))
 
 (defun nntp-async-trigger (process)
-  (save-excursion
-    (set-buffer (process-buffer process))
+  (with-current-buffer (process-buffer process)
     (when nntp-process-callback
       ;; do we have an error message?
       (goto-char nntp-process-start-point)
@@ -1357,12 +1419,11 @@ password contained in '~/.nntp-authinfo'."
            (let ((buf (current-buffer))
                  (start nntp-process-start-point)
                  (decode nntp-process-decode))
-             (save-excursion
-               (set-buffer nntp-process-to-buffer)
+             (with-current-buffer nntp-process-to-buffer
                (goto-char (point-max))
                (save-restriction
                  (narrow-to-region (point) (point))
-                 (insert-buffer-substring buf start)
+                 (nntp-insert-buffer-substring buf start)
                  (when decode
                    (nntp-decode-text))))))
          ;; report it.
@@ -1386,22 +1447,22 @@ password contained in '~/.nntp-authinfo'."
 
 (defun nntp-accept-process-output (process)
   "Wait for output from PROCESS and message some dots."
-  (save-excursion
-    (set-buffer (or (nntp-find-connection-buffer nntp-server-buffer)
-                   nntp-server-buffer))
+  (with-current-buffer (or (nntp-find-connection-buffer nntp-server-buffer)
+                           nntp-server-buffer)
     (let ((len (/ (buffer-size) 1024))
          message-log-max)
       (unless (< len 10)
        (setq nntp-have-messaged t)
        (nnheader-message 7 "nntp read: %dk" len)))
-    (nnheader-accept-process-output process)
-    ;; accept-process-output may update status of process to indicate
-    ;; that the server has closed the connection.  This MUST be
-    ;; handled here as the buffer restored by the save-excursion may
-    ;; be the process's former output buffer (i.e. now killed)
-    (or (and process
-            (memq (process-status process) '(open run)))
-        (nntp-report "Server closed connection"))))
+    (prog1
+       (nnheader-accept-process-output process)
+      ;; accept-process-output may update status of process to indicate
+      ;; that the server has closed the connection.  This MUST be
+      ;; handled here as the buffer restored by the save-excursion may
+      ;; be the process's former output buffer (i.e. now killed)
+      (or (and process
+              (memq (process-status process) '(open run)))
+          (nntp-report "Server closed connection")))))
 
 (defun nntp-accept-response ()
   "Wait for output from the process that outputs to BUFFER."
@@ -1422,8 +1483,7 @@ password contained in '~/.nntp-authinfo'."
       (cond ((not entry)
              (nntp-report "Server closed connection"))
             ((not (equal group (caddr entry)))
-             (save-excursion
-               (set-buffer (process-buffer (car entry)))
+             (with-current-buffer (process-buffer (car entry))
                (erase-buffer)
                (nntp-send-command "^[245].*\n" "GROUP" group)
                (setcar (cddr entry) group)
@@ -1591,7 +1651,7 @@ password contained in '~/.nntp-authinfo'."
        (when in-process-buffer-p
          (set-buffer buf)
          (goto-char (point-max))
-         (insert-buffer-substring process-buffer)
+         (nntp-insert-buffer-substring process-buffer)
          (set-buffer process-buffer)
          (erase-buffer)
          (set-buffer buf))
@@ -1623,8 +1683,7 @@ password contained in '~/.nntp-authinfo'."
        ;; We try them all until we get at positive response.
        (while (and commands (eq nntp-server-xover 'try))
          (nntp-send-command-nodelete "\r?\n\\.\r?\n" (car commands) range)
-         (save-excursion
-           (set-buffer nntp-server-buffer)
+         (with-current-buffer nntp-server-buffer
            (goto-char (point-min))
            (and (looking-at "[23]")    ; No error message.
                 ;; We also have to look at the lines.  Some buggy
@@ -1632,7 +1691,8 @@ password contained in '~/.nntp-authinfo'."
                 ;; article number.  How... helpful.
                 (progn
                   (forward-line 1)
-                  (looking-at "[0-9]+\t...")) ; More text after number.
+                  ;; More text after number, or a dot.
+                  (looking-at "[0-9]+\t...\\|\\.\r?\n"))
                 (setq nntp-server-xover (car commands))))
          (setq commands (cdr commands)))
        ;; If none of the commands worked, we disable XOVER.
@@ -1644,6 +1704,7 @@ password contained in '~/.nntp-authinfo'."
 (defun nntp-find-group-and-number (&optional group)
   (save-excursion
     (save-restriction
+      ;; FIXME: This is REALLY FISHY: set-buffer after save-restriction?!?
       (set-buffer nntp-server-buffer)
       (narrow-to-region (goto-char (point-min))
                        (or (search-forward "\n\n" nil t) (point-max)))
@@ -1681,7 +1742,8 @@ password contained in '~/.nntp-authinfo'."
                    (match-string 1 xref))
                   (t "")))
          (cond
-          ((and (setq xref (mail-fetch-field "xref"))
+          ((and (not nntp-xref-number-is-evil)
+                (setq xref (mail-fetch-field "xref"))
                 (string-match
                  (if group
                      (concat "\\(" (regexp-quote group) "\\):\\([0-9]+\\)")
@@ -1707,7 +1769,7 @@ password contained in '~/.nntp-authinfo'."
     (while (and (setq proc (get-buffer-process buf))
                (memq (process-status proc) '(open run))
                (not (re-search-forward regexp nil t)))
-      (accept-process-output proc)
+      (accept-process-output proc 0.1)
       (set-buffer buf)
       (goto-char (point-min)))))
 
@@ -1747,9 +1809,21 @@ via telnet.")
 (defvoo nntp-telnet-passwd nil
   "Password to use to log in via telnet with.")
 
+(defun nntp-service-to-port (svc)
+  (cond
+   ((integerp svc) (number-to-string svc))
+   ((string-match "\\`[0-9]+\\'" svc) svc)
+   (t
+    (with-temp-buffer
+      (ignore-errors (insert-file-contents "/etc/services"))
+      (goto-char (point-min))
+      (if (re-search-forward (concat "^" (regexp-quote svc)
+                                     "[ \t]+\\([0-9]+\\)/tcp"))
+          (match-string 1)
+        svc)))))
+
 (defun nntp-open-telnet (buffer)
-  (save-excursion
-    (set-buffer buffer)
+  (with-current-buffer buffer
     (erase-buffer)
     (let ((proc (apply
                 'start-process
@@ -1805,8 +1879,7 @@ via telnet.")
                (apply 'start-process
                       "nntpd" buffer nntp-rlogin-program nntp-address
                       nntp-rlogin-parameters))))
-    (save-excursion
-      (set-buffer buffer)
+    (with-current-buffer buffer
       (nntp-wait-for-string "^\r*20[01]")
       (beginning-of-line)
       (delete-region (point-min) (point))
@@ -1819,6 +1892,8 @@ via telnet.")
 
 (defun nntp-open-telnet-stream (buffer)
   "Open a nntp connection by telnet'ing the news server.
+`nntp-open-netcat-stream' is recommended in place of this function
+because it is more reliable.
 
 Please refer to the following variables to customize the connection:
 - `nntp-pre-command',
@@ -1829,13 +1904,13 @@ Please refer to the following variables to customize the connection:
 - `nntp-end-of-line'."
   (let ((command `(,nntp-telnet-command
                   ,@nntp-telnet-switches
-                  ,nntp-address ,nntp-port-number))
+                  ,nntp-address
+                  ,(nntp-service-to-port nntp-port-number)))
        proc)
     (and nntp-pre-command
         (push nntp-pre-command command))
     (setq proc (apply 'start-process "nntpd" buffer command))
-    (save-excursion
-      (set-buffer buffer)
+    (with-current-buffer buffer
       (nntp-wait-for-string "^\r*20[01]")
       (beginning-of-line)
       (delete-region (point-min) (point))
@@ -1845,6 +1920,8 @@ Please refer to the following variables to customize the connection:
   "Open a connection to an nntp server through an intermediate host.
 First rlogin to the remote host, and then telnet the real news server
 from there.
+`nntp-open-via-rlogin-and-netcat' is recommended in place of this function
+because it is more reliable.
 
 Please refer to the following variables to customize the connection:
 - `nntp-pre-command',
@@ -1869,11 +1946,11 @@ Please refer to the following variables to customize the connection:
     (and nntp-pre-command
         (push nntp-pre-command command))
     (setq proc (apply 'start-process "nntpd" buffer command))
-    (save-excursion
-      (set-buffer buffer)
+    (with-current-buffer buffer
       (nntp-wait-for-string "^r?telnet")
-      (process-send-string proc (concat "open " nntp-address
-                                       " " nntp-port-number "\n"))
+      (process-send-string proc (concat "open " nntp-address " "
+                                       (nntp-service-to-port nntp-port-number)
+                                       "\n"))
       (nntp-wait-for-string "^\r*20[01]")
       (beginning-of-line)
       (delete-region (point-min) (point))
@@ -1898,24 +1975,46 @@ Please refer to the following variables to customize the connection:
 - `nntp-via-rlogin-command-switches',
 - `nntp-via-user-name',
 - `nntp-via-address',
-- `nntp-via-netcat-command',
-- `nntp-via-netcat-switches',
+- `nntp-netcat-command',
+- `nntp-netcat-switches',
 - `nntp-address',
-- `nntp-port-number',
-- `nntp-end-of-line'."
+- `nntp-port-number'."
   (let ((command `(,@(when nntp-pre-command
                       (list nntp-pre-command))
                   ,nntp-via-rlogin-command
-                  ,@(when nntp-via-rlogin-command-switches
-                      nntp-via-rlogin-command-switches)
+                  ,@nntp-via-rlogin-command-switches
                   ,@(when nntp-via-user-name
                       (list "-l" nntp-via-user-name))
                   ,nntp-via-address
-                  ,nntp-via-netcat-command
-                  ,@nntp-via-netcat-switches
+                  ,nntp-netcat-command
+                  ,@nntp-netcat-switches
                   ,nntp-address
-                  ,nntp-port-number)))
-    (apply 'start-process "nntpd" buffer command)))
+                  ,(nntp-service-to-port nntp-port-number))))
+    ;; A non-nil connection type results in mightily odd behavior where
+    ;; (process-send-string proc "\^M") ends up sending a "\n" to the
+    ;; ssh process.  --Stef
+    ;; Also a nil connection allow ssh-askpass to work under X11.
+    (let ((process-connection-type nil))
+      (apply 'start-process "nntpd" buffer command))))
+
+(defun nntp-open-netcat-stream (buffer)
+  "Open a connection to an nntp server through netcat.
+I.e. use the `nc' command rather than Emacs's builtin networking code.
+
+Please refer to the following variables to customize the connection:
+- `nntp-pre-command',
+- `nntp-netcat-command',
+- `nntp-netcat-switches',
+- `nntp-address',
+- `nntp-port-number'."
+  (let ((command `(,nntp-netcat-command
+                  ,@nntp-netcat-switches
+                   ,nntp-address
+                   ,(nntp-service-to-port nntp-port-number))))
+    (and nntp-pre-command (push nntp-pre-command command))
+    (let ((process-connection-type nil)) ;See `nntp-open-via-rlogin-and-netcat'.
+      (apply 'start-process "nntpd" buffer command))))
+
 
 (defun nntp-open-via-telnet-and-telnet (buffer)
   "Open a connection to an nntp server through an intermediate host.
@@ -1936,8 +2035,7 @@ Please refer to the following variables to customize the connection:
 - `nntp-address',
 - `nntp-port-number',
 - `nntp-end-of-line'."
-  (save-excursion
-    (set-buffer buffer)
+  (with-current-buffer buffer
     (erase-buffer)
     (let ((command `(,nntp-via-telnet-command ,@nntp-via-telnet-switches))
          (case-fold-search t)
@@ -1974,7 +2072,7 @@ Please refer to the following variables to customize the connection:
                                     ,nntp-telnet-command
                                     ,@nntp-telnet-switches
                                     ,nntp-address
-                                    ,nntp-port-number)))
+                                    ,(nntp-service-to-port nntp-port-number))))
          (process-send-string proc
                               (concat (mapconcat 'identity
                                                  real-telnet-command " ")
@@ -1997,21 +2095,34 @@ Please refer to the following variables to customize the connection:
 (defun nntp-marks-directory (server)
   (expand-file-name server nntp-marks-directory))
 
+(defvar nntp-server-to-method-cache nil
+  "Alist of servers and select methods.")
+
+(defun nntp-group-pathname (server group &optional file)
+  "Return an absolute file name of FILE for GROUP on SERVER."
+  (let ((method (cdr (assoc server nntp-server-to-method-cache))))
+    (unless method
+      (push (cons server (setq method (or (gnus-server-to-method server)
+                                         (gnus-find-method-for-group group))))
+           nntp-server-to-method-cache))
+    (nnmail-group-pathname
+     (mm-decode-coding-string group
+                             (inline (gnus-group-name-charset method group)))
+     (nntp-marks-directory server)
+     file)))
+
 (defun nntp-possibly-create-directory (group server)
-  (let ((dir (nnmail-group-pathname
-             group (nntp-marks-directory server))))
+  (let ((dir (nntp-group-pathname server group))
+       (file-name-coding-system nnmail-pathname-coding-system))
     (unless (file-exists-p dir)
       (make-directory (directory-file-name dir) t)
       (nnheader-message 5 "Creating nntp marks directory %s" dir))))
 
-(eval-and-compile
-  (autoload 'time-less-p "time-date"))
+(autoload 'time-less-p "time-date")
 
 (defun nntp-marks-changed-p (group server)
-  (let ((file (expand-file-name
-              nntp-marks-file-name
-              (nnmail-group-pathname
-               group (nntp-marks-directory server)))))
+  (let ((file (nntp-group-pathname server group nntp-marks-file-name))
+       (file-name-coding-system nnmail-pathname-coding-system))
     (if (null (gnus-gethash file nntp-marks-modtime))
        t ;; never looked at marks file, assume it has changed
       (time-less-p (gnus-gethash file nntp-marks-modtime)
@@ -2019,10 +2130,7 @@ Please refer to the following variables to customize the connection:
 
 (defun nntp-save-marks (group server)
   (let ((file-name-coding-system nnmail-pathname-coding-system)
-       (file (expand-file-name
-              nntp-marks-file-name 
-              (nnmail-group-pathname
-               group (nntp-marks-directory server)))))
+       (file (nntp-group-pathname server group nntp-marks-file-name)))
     (condition-case err
        (progn
          (nntp-possibly-create-directory group server)
@@ -2038,10 +2146,8 @@ Please refer to the following variables to customize the connection:
                 (error "Cannot write to %s (%s)" file err))))))
 
 (defun nntp-open-marks (group server)
-  (let ((file (expand-file-name
-              nntp-marks-file-name
-              (nnmail-group-pathname
-               group (nntp-marks-directory server)))))
+  (let ((file (nntp-group-pathname server group nntp-marks-file-name))
+       (file-name-coding-system nnmail-pathname-coding-system))
     (if (file-exists-p file)
        (condition-case err
            (with-temp-buffer
@@ -2059,16 +2165,20 @@ Please refer to the following variables to customize the connection:
       (let ((info (gnus-get-info
                   (gnus-group-prefixed-name
                    group
-                   (gnus-server-to-method (format "nntp:%s" server))))))
-       (nnheader-message 7 "Bootstrapping marks for %s..." group)
+                   (gnus-server-to-method (format "nntp:%s" server)))))
+           (decoded-name (mm-decode-coding-string
+                          group
+                          (gnus-group-name-charset
+                           (gnus-server-to-method server) group))))
+       (nnheader-message 7 "Bootstrapping marks for %s..." decoded-name)
        (setq nntp-marks (gnus-info-marks info))
        (push (cons 'read (gnus-info-read info)) nntp-marks)
        (dolist (el gnus-article-unpropagated-mark-lists)
          (setq nntp-marks (gnus-remassoc el nntp-marks)))
        (nntp-save-marks group server)
-       (nnheader-message 7 "Bootstrapping marks for %s...done" group)))))
+       (nnheader-message 7 "Bootstrapping marks for %s...done"
+                         decoded-name)))))
 
 (provide 'nntp)
 
-;;; arch-tag: 8655466a-b1b5-4929-9c45-7b1b2e767271
 ;;; nntp.el ends here