;;; nntp.el --- NNTP (RFC977) Interface for GNU Emacs
-;; Copyright (C) 1987, 1988, 1989 Fujitsu Laboratories LTD.
-;; Copyright (C) 1987, 1988, 1989, 1990 Masanobu UMEDA
+;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; 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 distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
+;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+
;;; Commentary:
;; (1) Select routine may signal an error or fall into infinite loop
;; while waiting for the server response. In this case, you'd better
;; not use byte-compiled codes but original source. If you still have
-;; a problems with it, set the variable `nntp-buggy-select' to T.
+;; a problems with it, set the variable `nntp-buggy-select' to t.
;;
;; (2) Emacs may hang up while retrieving headers since too many
;; requests have been sent to the NNTP server without reading their
code, the correct kanji code of the buffer associated with the NNTP
server must be specified as follows:
-(setq nntp-server-hook
- '(lambda ()
+\(setq nntp-server-hook
+ (function
+ (lambda ()
;; Server's Kanji code is EUC (NEmacs hack).
(make-local-variable 'kanji-fileio-code)
- (setq kanji-fileio-code 0)))
+ (setq kanji-fileio-code 0))))
If you'd like to change something depending on the server in this
hook, use the variable `nntp-server-name'.")
-(defvar nntp-buggy-select (memq system-type '(usg-unix-v fujitsu-uts))
- "*T if your select routine is buggy.
+(defvar nntp-large-newsgroup 50
+ "*The number of the articles which indicates a large newsgroup.
+If the number of the articles is greater than the value, verbose
+messages will be shown to indicate the current status.")
+
+
+(defvar nntp-buggy-select (memq system-type '(fujitsu-uts))
+ "*Non-nil if your select routine is buggy.
If the select routine signals error or fall into infinite loop while
waiting for the server response, the variable must be set to t. In
-case of Fujitsu UTS, it is set to T since `accept-process-output'
+case of Fujitsu UTS, it is set to t since `accept-process-output'
doesn't work properly.")
(defvar nntp-maximum-request 400
If Emacs hangs up while retrieving headers, set the variable to a
lower value.")
-(defvar nntp-large-newsgroup 50
- "*The number of the articles which indicates a large newsgroup.
-If the number of the articles is greater than the value, verbose
-messages will be shown to indicate the current status.")
+(defvar nntp-debug-read 10000
+ "*Display '...' every 10Kbytes of a message being received if it is non-nil.
+If it is a number, dots are displayed per the number.")
\f
-(defconst nntp-version "NNTP 3.10"
+(defconst nntp-version "NNTP 3.12"
"Version numbers of this version of NNTP.")
(defvar nntp-server-name nil
You'd better not use this variable in NNTP front-end program but
instead use `nntp-server-buffer'.")
-(defvar nntp-status-message-string nil
+(defvar nntp-status-string nil
"Save the server response message.
You'd better not use this variable in NNTP front-end program but
instead call function `nntp-status-message' to get status message.")
(` (aset (, header) 6 (, id))))
(defmacro nntp-header-references (header)
- "Return references in HEADER."
+ "Return references (or in-reply-to) in HEADER."
(` (aref (, header) 7)))
(defmacro nntp-set-header-references (header ref)
"Return list of article headers specified by SEQUENCE of article id.
The format of list is
`([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'.
+If there is no References: field, In-Reply-To: field is used instead.
Reader macros for the vector are defined as `nntp-header-FIELD'.
Writer macros for the vector are defined as `nntp-set-header-FIELD'.
-News group must be selected before calling me."
+Newsgroup must be selected before calling this."
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
(and (numberp nntp-large-newsgroup)
(> number nntp-large-newsgroup)
(zerop (% received 20))
- (message "NNTP: %d%% of headers received."
+ (message "NNTP: Receiving headers... %d%%"
(/ (* received 100) number)))
(nntp-accept-response))
))
(nntp-accept-response)))
(and (numberp nntp-large-newsgroup)
(> number nntp-large-newsgroup)
- (message "NNTP: 100%% of headers received."))
+ (message "NNTP: Receiving headers... done"))
;; Now all of replies are received.
(setq received number)
;; First, fold continuation lines.
;; Thanks go to mly@AI.MIT.EDU (Richard Mlynarik)
(while (and (not (eobp))
(not (memq (following-char) '(?2 ?3))))
- (if (looking-at "\\(From\\|Subject\\|Date\\|Lines\\|Xref\\|References\\):[ \t]+\\([^ \t\n]+.*\\)\r$")
+ (if (looking-at "\\(From\\|Subject\\|Date\\|Lines\\|Xref\\|References\\|In-Reply-To\\):[ \t]+\\([^ \t\n]+.*\\)\r$")
(let ((s (buffer-substring
(match-beginning 2) (match-end 2)))
(c (char-after (match-beginning 0))))
(setq xref s))
((char-equal c ?R) ;References:
(setq references s))
+ ;; In-Reply-To: should be used only when
+ ;; there is no References: field.
+ ((and (char-equal c ?I) ;In-Reply-To:
+ (null references))
+ (setq references s))
)))
(forward-line 1))
;; Finished to parse one header.
(setq subject "(None)"))
(if (null from)
(setq from "(Unknown User)"))
- (setq headers
- (cons (vector article subject from
- xref lines date
- message-id references) headers))
+ ;; Collect valid article only.
+ (and article
+ message-id
+ (setq headers
+ (cons (vector article subject from
+ xref lines date
+ message-id references) headers)))
)
(t (forward-line 1))
)
If optional argument SERVICE is non-nil, open by the service name."
(let ((host (or host (getenv "NNTPSERVER")))
(status nil))
- (setq nntp-status-message-string "")
+ (setq nntp-status-string "")
(cond ((and host (nntp-open-server-internal host service))
(setq status (nntp-wait-for-response "^[23].*\r$"))
;; Do check unexpected close of connection.
;; Suggested by feldmark@hanako.stars.flab.fujitsu.junet.
(if status
- (set-process-sentinel nntp-server-process
- 'nntp-default-sentinel)
+ (progn (set-process-sentinel nntp-server-process
+ 'nntp-default-sentinel)
+ (nntp-send-command "^[25].*\r$" "MODE" "READER"))
;; We have to close connection here, since function
;; `nntp-server-opened' may return incorrect status.
(nntp-close-server-internal)
))
((null host)
- (setq nntp-status-message-string "NNTP server is not specified."))
+ (setq nntp-status-string "NNTP server is not specified."))
)
status
))
(defun nntp-status-message ()
"Return server status response as string."
- (if (and nntp-status-message-string
+ (if (and nntp-status-string
;; NNN MESSAGE
(string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$"
- nntp-status-message-string))
- (substring nntp-status-message-string (match-beginning 1) (match-end 1))
+ nntp-status-string))
+ (substring nntp-status-string (match-beginning 1) (match-end 1))
;; Empty message if nothing.
""
))
(defun nntp-request-article (id)
"Select article by message ID (or number)."
+ (if (numberp id)
+ (setq id (number-to-string id)))
(prog1
;; If NEmacs, end of message may look like: "\256\215" (".^M")
(nntp-send-command "^\\.\r$" "ARTICLE" id)
(nntp-send-command "^[23].*$" "GROUP" group))
(defun nntp-request-list ()
- "List valid newsgoups."
+ "List active newsgroups."
(prog1
(nntp-send-command "^\\.\r$" "LIST")
(nntp-decode-text)
))
+(defun nntp-request-list-newsgroups ()
+ "List newsgroups (defined in NNTP2)."
+ (prog1
+ (nntp-send-command "^\\.\r$" "LIST NEWSGROUPS")
+ (nntp-decode-text)
+ ))
+
+(defun nntp-request-list-distributions ()
+ "List distributions (defined in NNTP2)."
+ (prog1
+ (nntp-send-command "^\\.\r$" "LIST DISTRIBUTIONS")
+ (nntp-decode-text)
+ ))
+
(defun nntp-request-last ()
- "Set current article pointer to the previous article in the current news group."
+ "Set current article pointer to the previous article
+in the current news group."
(nntp-send-command "^[23].*\r$" "LAST"))
(defun nntp-request-next ()
(insert "."))
;; Insert `.' at end of buffer (end of text mark).
(goto-char (point-max))
- (insert ".\n")
+ (insert ".\r\n")
))
\f
"Wait for server response which matches REGEXP."
(save-excursion
(let ((status t)
- (wait t))
+ (wait t)
+ (dotnum 0) ;Number of "." being displayed.
+ (dotsize ;How often "." displayed.
+ (if (numberp nntp-debug-read) nntp-debug-read 10000)))
(set-buffer nntp-server-buffer)
;; Wait for status response (RFC977).
;; 1xx - Informative message.
))
;; Save status message.
(end-of-line)
- (setq nntp-status-message-string
+ (setq nntp-status-string
(buffer-substring (point-min) (point)))
(if status
(progn
;; (save-excursion (end-of-line) (point))))
(if (looking-at regexp)
(setq wait nil)
- (message "NNTP: Reading...")
+ (if nntp-debug-read
+ (let ((newnum (/ (buffer-size) dotsize)))
+ (if (not (= dotnum newnum))
+ (progn
+ (setq dotnum newnum)
+ (message "NNTP: Reading %s"
+ (make-string dotnum ?.))))))
(nntp-accept-response)
- (message "")
+ ;;(if nntp-debug-read (message ""))
))
+ ;; Remove "...".
+ (if (and nntp-debug-read (> dotnum 0))
+ (message ""))
;; Successfully received server response.
t
))
"Send list of STRINGS to news server as command and its arguments."
(let ((cmd (car strings))
(strings (cdr strings)))
- ;; Command and each argument must be separeted by one or more spaces.
+ ;; Command and each argument must be separated by one or more spaces.
(while strings
(setq cmd (concat cmd " " (car strings)))
(setq strings (cdr strings)))
;; Command line must be terminated by a CR-LF.
- (process-send-string nntp-server-process (concat cmd "\n"))
+ (process-send-string nntp-server-process (concat cmd "\r\n"))
))
(defun nntp-send-region-to-server (begin end)
;; process because of NEmacs hack.
(copy-to-buffer nntp-server-buffer begin end)
(set-buffer nntp-server-buffer)
- (setq begin (point-min))
- (setq end (point-max))
- ;; `process-send-region' does not work if text to be sent is very
- ;; large. I don't know maximum size of text sent correctly.
- (let ((last nil)
- (size 100)) ;Size of text sent at once.
- (save-restriction
- (narrow-to-region begin end)
- (goto-char begin)
- (while (not (eobp))
- ;;(setq last (min end (+ (point) size)))
- ;; NEmacs gets confused if character at `last' is Kanji.
- (setq last (save-excursion
- (goto-char (min end (+ (point) size)))
- (or (eobp) (forward-char 1)) ;Adjust point
- (point)))
- (process-send-region nntp-server-process (point) last)
- ;; I don't know whether the next codes solve the known
- ;; problem of communication error of GNU Emacs.
- (accept-process-output)
- ;;(sit-for 0)
- (goto-char last)
- )))
+ (process-send-region nntp-server-process (point-min) (point-max))
;; We cannot erase buffer, because reply may be received.
(delete-region begin end)
))
HCoop / bpt / emacs.git / blobdiff