Merge from gnus--rel--5.10
[gnus] / lisp / nntp.el
index 531c916..c8c14da 100644 (file)
@@ -2,7 +2,7 @@
 
 ;; 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 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -11,7 +11,7 @@
 
 ;; 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
+;; by the Free Software Foundation; either version 3, or (at your
 ;; option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful, but
@@ -32,6 +32,7 @@
 (require 'nnoo)
 (require 'gnus-util)
 (require 'gnus)
+(require 'gnus-group) ;; gnus-group-name-charset
 
 (nnoo-declare nntp)
 
@@ -90,6 +91,21 @@ Indirect connections:
 - `nntp-open-via-rlogin-and-netcat',
 - `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.")
@@ -178,6 +194,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 +278,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)
 
@@ -478,19 +503,22 @@ 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)
              (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))))
 
@@ -1116,7 +1144,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the
 .authinfo file has the FORCE token."
   (let* ((list (netrc-parse nntp-authinfo-file))
         (alist (netrc-machine list nntp-address "nntp"))
-        (force (netrc-get alist "force"))
+        (force (or (netrc-get alist "force") nntp-authinfo-force))
         (user (or (netrc-get alist "login") nntp-authinfo-user))
         (passwd (netrc-get alist "password")))
     (when (or (not send-if-force)
@@ -1204,7 +1232,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))))
@@ -1632,7 +1660,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.
@@ -1681,7 +1710,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]+\\)")
@@ -1997,9 +2027,25 @@ 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))))
@@ -2008,10 +2054,8 @@ Please refer to the following variables to customize the connection:
   (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 +2063,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 +2079,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,14 +2098,19 @@ 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)