;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993,
;; 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002,
-;; 2003, 2004, 2005, 2006, 2007, 2008 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
;;; Code:
+;; For Emacs < 22.2.
+(eval-and-compile
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+
(require 'nnheader)
(require 'nnoo)
(require 'gnus-util)
(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)
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")
"\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)
(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)))))
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)
(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)
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
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 (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-source-user-or-password "login" nntp-address "nntp")
+ auth-user
(netrc-get alist "login")
nntp-authinfo-user))
(passwd (or
;; this is preferred to netrc-*
- (auth-source-user-or-password "password" nntp-address "nntp")
+ auth-passwd
(netrc-get alist "password"))))
(when (or (not send-if-force)
force)
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
(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)))))
(defun nntp-service-to-port (svc)
(cond
((integerp svc) (number-to-string svc))
- ((string-match "\\`[[:digit:]]\\'" svc) 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]+\\([[:digit:]]+\\)/tcp"))
+ "[ \t]+\\([0-9]+\\)/tcp"))
(match-string 1)
svc)))))
(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.
(provide 'nntp)
-;; arch-tag: 8655466a-b1b5-4929-9c45-7b1b2e767271
;;; nntp.el ends here
projects / gnus / blobdiff