annotate lisp/=nntp.el @ 2921:37503f466755

Some time-handling patches from Paul Eggert: * editfns.c (Fcurrent_time_zone): Take an optional argument specifying what (absolute) time should be used to determine the current time zone. Yield just offset and name of time zone, including DST correction. Yield time zone offset in seconds, not minutes. (lisp_time_argument, difftm): New functions. (Fcurrent_time_string): Use lisp_time_argument. * systime.h (EMACS_CURRENT_TIME_ZONE, EMACS_GET_TZ_OFFSET, EMACS_GET_TZ_NAMES): Remove. * config.h.in: Add HAVE_TM_ZONE.
author Jim Blandy <jimb@redhat.com>
date Thu, 20 May 1993 06:29:45 +0000
parents cd90d49526ae
children 507f64624555
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
659
505130d1ddf8 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
1 ;;; nntp.el --- NNTP (RFC977) Interface for GNU Emacs
505130d1ddf8 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
2
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
3 ;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993 Free Software Foundation, Inc.
846
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
4
790
47ec7c4c42bc *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 659
diff changeset
5 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
814
38b2499cb3e9 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 790
diff changeset
6 ;; Keywords: news
790
47ec7c4c42bc *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 659
diff changeset
7
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
8 ;; This file is part of GNU Emacs.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
9
882
bff32d8ecc5e entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
bff32d8ecc5e entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
11 ;; it under the terms of the GNU General Public License as published by
bff32d8ecc5e entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
bff32d8ecc5e entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
13 ;; any later version.
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
14
882
bff32d8ecc5e entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
15 ;; GNU Emacs is distributed in the hope that it will be useful,
bff32d8ecc5e entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
bff32d8ecc5e entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
bff32d8ecc5e entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
18 ;; GNU General Public License for more details.
bff32d8ecc5e entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
19
bff32d8ecc5e entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
20 ;; You should have received a copy of the GNU General Public License
bff32d8ecc5e entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
bff32d8ecc5e entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
bff32d8ecc5e entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 853
diff changeset
23
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
24
790
47ec7c4c42bc *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 659
diff changeset
25 ;;; Commentary:
47ec7c4c42bc *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 659
diff changeset
26
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
27 ;; This implementation is tested on both 1.2a and 1.5 version of the
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
28 ;; NNTP package.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
29
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
30 ;; Troubleshooting of NNTP
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
31 ;;
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
32 ;; (1) Select routine may signal an error or fall into infinite loop
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
33 ;; while waiting for the server response. In this case, you'd better
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
34 ;; not use byte-compiled codes but original source. If you still have
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
35 ;; a problems with it, set the variable `nntp-buggy-select' to T.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
36 ;;
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
37 ;; (2) Emacs may hang up while retrieving headers since too many
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
38 ;; requests have been sent to the NNTP server without reading their
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
39 ;; replies. In this case, reduce the number of the requests sent to
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
40 ;; the server at one time by setting the variable
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
41 ;; `nntp-maximum-request' to a lower value.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
42 ;;
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
43 ;; (3) If the TCP/IP stream (open-network-stream) is not supported by
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
44 ;; emacs, compile and install `tcp.el' and `tcp.c' which is an
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
45 ;; emulation program of the stream. If you modified `tcp.c' for your
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
46 ;; system, please send me the diffs. I'll include some of them in the
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
47 ;; future releases.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
48
790
47ec7c4c42bc *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 659
diff changeset
49 ;;; Code:
47ec7c4c42bc *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 659
diff changeset
50
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
51 (defvar nntp-server-hook nil
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
52 "*Hooks for the NNTP server.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
53 If the kanji code of the NNTP server is different from the local kanji
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
54 code, the correct kanji code of the buffer associated with the NNTP
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
55 server must be specified as follows:
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
56
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
57 (setq nntp-server-hook
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
58 (function
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
59 (lambda ()
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
60 ;; Server's Kanji code is EUC (NEmacs hack).
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
61 (make-local-variable 'kanji-fileio-code)
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
62 (setq kanji-fileio-code 0))))
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
63
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
64 If you'd like to change something depending on the server in this
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
65 hook, use the variable `nntp-server-name'.")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
66
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
67 (defvar nntp-large-newsgroup 50
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
68 "*The number of the articles which indicates a large newsgroup.
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
69 If the number of the articles is greater than the value, verbose
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
70 messages will be shown to indicate the current status.")
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
71
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
72 (defvar nntp-buggy-select (memq system-type '(usg-unix-v fujitsu-uts))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
73 "*T if your select routine is buggy.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
74 If the select routine signals error or fall into infinite loop while
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
75 waiting for the server response, the variable must be set to t. In
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
76 case of Fujitsu UTS, it is set to T since `accept-process-output'
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
77 doesn't work properly.")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
78
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
79 (defvar nntp-maximum-request 400
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
80 "*The maximum number of the requests sent to the NNTP server at one time.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
81 If Emacs hangs up while retrieving headers, set the variable to a
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
82 lower value.")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
83
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
84 (defvar nntp-debug-read 10000
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
85 "*Display '...' every 10Kbytes of a message being received if it is non-nil.
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
86 If it is a number, dots are displayed per the number.")
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
88
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
89 (defconst nntp-version "NNTP 3.12"
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
90 "Version numbers of this version of NNTP.")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
91
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
92 (defvar nntp-server-name nil
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
93 "The name of the host running NNTP server.")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
94
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
95 (defvar nntp-server-buffer nil
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
96 "Buffer associated with NNTP server process.")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
97
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
98 (defvar nntp-server-process nil
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
99 "The NNTP server process.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
100 You'd better not use this variable in NNTP front-end program but
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
101 instead use `nntp-server-buffer'.")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
102
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
103 (defvar nntp-status-string nil
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
104 "Save the server response message.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
105 You'd better not use this variable in NNTP front-end program but
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
106 instead call function `nntp-status-message' to get status message.")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
107
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
108 ;;;
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
109 ;;; Extended Command for retrieving many headers.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
110 ;;;
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
111 ;; Retrieving lots of headers by sending command asynchronously.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
112 ;; Access functions to headers are defined as macro.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
113
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
114 (defmacro nntp-header-number (header)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
115 "Return article number in HEADER."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
116 (` (aref (, header) 0)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
117
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
118 (defmacro nntp-set-header-number (header number)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
119 "Set article number of HEADER to NUMBER."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
120 (` (aset (, header) 0 (, number))))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
121
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
122 (defmacro nntp-header-subject (header)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
123 "Return subject string in HEADER."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
124 (` (aref (, header) 1)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
125
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
126 (defmacro nntp-set-header-subject (header subject)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
127 "Set article subject of HEADER to SUBJECT."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
128 (` (aset (, header) 1 (, subject))))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
129
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
130 (defmacro nntp-header-from (header)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
131 "Return author string in HEADER."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
132 (` (aref (, header) 2)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
133
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
134 (defmacro nntp-set-header-from (header from)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
135 "Set article author of HEADER to FROM."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
136 (` (aset (, header) 2 (, from))))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
137
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
138 (defmacro nntp-header-xref (header)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
139 "Return xref string in HEADER."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
140 (` (aref (, header) 3)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
141
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
142 (defmacro nntp-set-header-xref (header xref)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
143 "Set article xref of HEADER to xref."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
144 (` (aset (, header) 3 (, xref))))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
145
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
146 (defmacro nntp-header-lines (header)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
147 "Return lines in HEADER."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
148 (` (aref (, header) 4)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
149
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
150 (defmacro nntp-set-header-lines (header lines)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
151 "Set article lines of HEADER to LINES."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
152 (` (aset (, header) 4 (, lines))))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
153
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
154 (defmacro nntp-header-date (header)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
155 "Return date in HEADER."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
156 (` (aref (, header) 5)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
157
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
158 (defmacro nntp-set-header-date (header date)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
159 "Set article date of HEADER to DATE."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
160 (` (aset (, header) 5 (, date))))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
161
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
162 (defmacro nntp-header-id (header)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
163 "Return Id in HEADER."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
164 (` (aref (, header) 6)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
165
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
166 (defmacro nntp-set-header-id (header id)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
167 "Set article Id of HEADER to ID."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
168 (` (aset (, header) 6 (, id))))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
169
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
170 (defmacro nntp-header-references (header)
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
171 "Return references (or in-reply-to) in HEADER."
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
172 (` (aref (, header) 7)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
173
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
174 (defmacro nntp-set-header-references (header ref)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
175 "Set article references of HEADER to REF."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
176 (` (aset (, header) 7 (, ref))))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
177
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
178 (defun nntp-retrieve-headers (sequence)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
179 "Return list of article headers specified by SEQUENCE of article id.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
180 The format of list is
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
181 `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'.
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
182 If there is no References: field, In-Reply-To: field is used instead.
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
183 Reader macros for the vector are defined as `nntp-header-FIELD'.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
184 Writer macros for the vector are defined as `nntp-set-header-FIELD'.
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
185 Newsgroup must be selected before calling this."
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
186 (save-excursion
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
187 (set-buffer nntp-server-buffer)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
188 (erase-buffer)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
189 (let ((number (length sequence))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
190 (last-point (point-min))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
191 (received 0)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
192 (count 0)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
193 (headers nil) ;Result list.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
194 (article 0)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
195 (subject nil)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
196 (message-id)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
197 (from nil)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
198 (xref nil)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
199 (lines 0)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
200 (date nil)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
201 (references nil))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
202 ;; Send HEAD command.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
203 (while sequence
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
204 (nntp-send-strings-to-server "HEAD" (car sequence))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
205 (setq sequence (cdr sequence))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
206 (setq count (1+ count))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
207 ;; Every 400 header requests we have to read stream in order
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
208 ;; to avoid deadlock.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
209 (if (or (null sequence) ;All requests have been sent.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
210 (zerop (% count nntp-maximum-request)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
211 (progn
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
212 (accept-process-output)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
213 (while (progn
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
214 (goto-char last-point)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
215 ;; Count replies.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
216 (while (re-search-forward "^[0-9]" nil t)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
217 (setq received (1+ received)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
218 (setq last-point (point))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
219 (< received count))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
220 ;; If number of headers is greater than 100, give
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
221 ;; informative messages.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
222 (and (numberp nntp-large-newsgroup)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
223 (> number nntp-large-newsgroup)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
224 (zerop (% received 20))
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
225 (message "NNTP: Receiving headers... %d%%"
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
226 (/ (* received 100) number)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
227 (nntp-accept-response))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
228 ))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
229 )
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
230 ;; Wait for text of last command.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
231 (goto-char (point-max))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
232 (re-search-backward "^[0-9]" nil t)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
233 (if (looking-at "^[23]")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
234 (while (progn
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
235 (goto-char (- (point-max) 3))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
236 (not (looking-at "^\\.\r$")))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
237 (nntp-accept-response)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
238 (and (numberp nntp-large-newsgroup)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
239 (> number nntp-large-newsgroup)
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
240 (message "NNTP: Receiving headers... done"))
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
241 ;; Now all of replies are received.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
242 (setq received number)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
243 ;; First, fold continuation lines.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
244 (goto-char (point-min))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
245 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
246 (replace-match " " t t))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
247 ;;(delete-non-matching-lines
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
248 ;; "^Subject:\\|^Xref:\\|^From:\\|^Lines:\\|^Date:\\|^References:\\|^[23]")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
249 (and (numberp nntp-large-newsgroup)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
250 (> number nntp-large-newsgroup)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
251 (message "NNTP: Parsing headers..."))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
252 ;; Then examines replies.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
253 (goto-char (point-min))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
254 (while (not (eobp))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
255 (cond ((looking-at "^[23][0-9][0-9][ \t]+\\([0-9]+\\)[ \t]+\\(<[^>]+>\\)")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
256 (setq article
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
257 (string-to-int
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
258 (buffer-substring (match-beginning 1) (match-end 1))))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
259 (setq message-id
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
260 (buffer-substring (match-beginning 2) (match-end 2)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
261 (forward-line 1)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
262 ;; Set default value.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
263 (setq subject nil)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
264 (setq xref nil)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
265 (setq from nil)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
266 (setq lines 0)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
267 (setq date nil)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
268 (setq references nil)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
269 ;; Thanks go to mly@AI.MIT.EDU (Richard Mlynarik)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
270 (while (and (not (eobp))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
271 (not (memq (following-char) '(?2 ?3))))
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
272 (if (looking-at "\\(From\\|Subject\\|Date\\|Lines\\|Xref\\|References\\|In-Reply-To\\):[ \t]+\\([^ \t\n]+.*\\)\r$")
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
273 (let ((s (buffer-substring
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
274 (match-beginning 2) (match-end 2)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
275 (c (char-after (match-beginning 0))))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
276 ;; We don't have to worry about letter case.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
277 (cond ((char-equal c ?F) ;From:
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
278 (setq from s))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
279 ((char-equal c ?S) ;Subject:
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
280 (setq subject s))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
281 ((char-equal c ?D) ;Date:
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
282 (setq date s))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
283 ((char-equal c ?L) ;Lines:
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
284 (setq lines (string-to-int s)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
285 ((char-equal c ?X) ;Xref:
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
286 (setq xref s))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
287 ((char-equal c ?R) ;References:
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
288 (setq references s))
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
289 ;; In-Reply-To: should be used only when
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
290 ;; there is no References: field.
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
291 ((and (char-equal c ?I) ;In-Reply-To:
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
292 (null references))
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
293 (setq references s))
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
294 )))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
295 (forward-line 1))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
296 ;; Finished to parse one header.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
297 (if (null subject)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
298 (setq subject "(None)"))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
299 (if (null from)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
300 (setq from "(Unknown User)"))
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
301 ;; Collect valid article only.
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
302 (and article
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
303 message-id
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
304 (setq headers
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
305 (cons (vector article subject from
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
306 xref lines date
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
307 message-id references) headers)))
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
308 )
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
309 (t (forward-line 1))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
310 )
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
311 (setq received (1- received))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
312 (and (numberp nntp-large-newsgroup)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
313 (> number nntp-large-newsgroup)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
314 (zerop (% received 20))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
315 (message "NNTP: Parsing headers... %d%%"
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
316 (/ (* received 100) number)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
317 )
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
318 (and (numberp nntp-large-newsgroup)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
319 (> number nntp-large-newsgroup)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
320 (message "NNTP: Parsing headers... done"))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
321 (nreverse headers)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
322 )))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
323
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
324
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
325 ;;;
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
326 ;;; Raw Interface to Network News Transfer Protocol (RFC977).
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
327 ;;;
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
328
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
329 (defun nntp-open-server (host &optional service)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
330 "Open news server on HOST.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
331 If HOST is nil, use value of environment variable `NNTPSERVER'.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
332 If optional argument SERVICE is non-nil, open by the service name."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
333 (let ((host (or host (getenv "NNTPSERVER")))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
334 (status nil))
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
335 (setq nntp-status-string "")
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
336 (cond ((and host (nntp-open-server-internal host service))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
337 (setq status (nntp-wait-for-response "^[23].*\r$"))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
338 ;; Do check unexpected close of connection.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
339 ;; Suggested by feldmark@hanako.stars.flab.fujitsu.junet.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
340 (if status
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
341 (set-process-sentinel nntp-server-process
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
342 'nntp-default-sentinel)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
343 ;; We have to close connection here, since function
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
344 ;; `nntp-server-opened' may return incorrect status.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
345 (nntp-close-server-internal)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
346 ))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
347 ((null host)
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
348 (setq nntp-status-string "NNTP server is not specified."))
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
349 )
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
350 status
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
351 ))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
352
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
353 (defun nntp-close-server ()
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
354 "Close news server."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
355 (unwind-protect
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
356 (progn
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
357 ;; Un-set default sentinel function before closing connection.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
358 (and nntp-server-process
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
359 (eq 'nntp-default-sentinel
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
360 (process-sentinel nntp-server-process))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
361 (set-process-sentinel nntp-server-process nil))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
362 ;; We cannot send QUIT command unless the process is running.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
363 (if (nntp-server-opened)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
364 (nntp-send-command nil "QUIT"))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
365 )
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
366 (nntp-close-server-internal)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
367 ))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
368
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
369 (fset 'nntp-request-quit (symbol-function 'nntp-close-server))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
370
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
371 (defun nntp-server-opened ()
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
372 "Return server process status, T or NIL.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
373 If the stream is opened, return T, otherwise return NIL."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
374 (and nntp-server-process
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
375 (memq (process-status nntp-server-process) '(open run))))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
376
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
377 (defun nntp-status-message ()
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
378 "Return server status response as string."
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
379 (if (and nntp-status-string
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
380 ;; NNN MESSAGE
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
381 (string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$"
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
382 nntp-status-string))
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
383 (substring nntp-status-string (match-beginning 1) (match-end 1))
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
384 ;; Empty message if nothing.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
385 ""
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
386 ))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
387
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
388 (defun nntp-request-article (id)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
389 "Select article by message ID (or number)."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
390 (prog1
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
391 ;; If NEmacs, end of message may look like: "\256\215" (".^M")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
392 (nntp-send-command "^\\.\r$" "ARTICLE" id)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
393 (nntp-decode-text)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
394 ))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
395
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
396 (defun nntp-request-body (id)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
397 "Select article body by message ID (or number)."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
398 (prog1
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
399 ;; If NEmacs, end of message may look like: "\256\215" (".^M")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
400 (nntp-send-command "^\\.\r$" "BODY" id)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
401 (nntp-decode-text)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
402 ))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
403
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
404 (defun nntp-request-head (id)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
405 "Select article head by message ID (or number)."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
406 (prog1
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
407 (nntp-send-command "^\\.\r$" "HEAD" id)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
408 (nntp-decode-text)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
409 ))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
410
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
411 (defun nntp-request-stat (id)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
412 "Select article by message ID (or number)."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
413 (nntp-send-command "^[23].*\r$" "STAT" id))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
414
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
415 (defun nntp-request-group (group)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
416 "Select news GROUP."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
417 ;; 1.2a NNTP's group command is buggy. "^M" (\r) is not appended to
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
418 ;; end of the status message.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
419 (nntp-send-command "^[23].*$" "GROUP" group))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
420
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
421 (defun nntp-request-list ()
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
422 "List active newsgroups."
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
423 (prog1
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
424 (nntp-send-command "^\\.\r$" "LIST")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
425 (nntp-decode-text)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
426 ))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
427
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
428 (defun nntp-request-list-newsgroups ()
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
429 "List newsgroups (defined in NNTP2)."
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
430 (prog1
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
431 (nntp-send-command "^\\.\r$" "LIST NEWSGROUPS")
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
432 (nntp-decode-text)
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
433 ))
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
434
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
435 (defun nntp-request-list-distributions ()
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
436 "List distributions (defined in NNTP2)."
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
437 (prog1
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
438 (nntp-send-command "^\\.\r$" "LIST DISTRIBUTIONS")
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
439 (nntp-decode-text)
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
440 ))
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
441
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
442 (defun nntp-request-last ()
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
443 "Set current article pointer to the previous article
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
444 in the current news group."
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
445 (nntp-send-command "^[23].*\r$" "LAST"))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
446
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
447 (defun nntp-request-next ()
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
448 "Advance current article pointer."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
449 (nntp-send-command "^[23].*\r$" "NEXT"))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
450
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
451 (defun nntp-request-post ()
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
452 "Post a new news in current buffer."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
453 (if (nntp-send-command "^[23].*\r$" "POST")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
454 (progn
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
455 (nntp-encode-text)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
456 (nntp-send-region-to-server (point-min) (point-max))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
457 ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
458 ;; appended to end of the status message.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
459 (nntp-wait-for-response "^[23].*$")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
460 )))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
461
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
462 (defun nntp-default-sentinel (proc status)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
463 "Default sentinel function for NNTP server process."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
464 (if (and nntp-server-process
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
465 (not (nntp-server-opened)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
466 (error "NNTP: Connection closed.")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
467 ))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
468
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
469 ;; Encoding and decoding of NNTP text.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
470
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
471 (defun nntp-decode-text ()
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
472 "Decode text transmitted by NNTP.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
473 0. Delete status line.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
474 1. Delete `^M' at end of line.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
475 2. Delete `.' at end of buffer (end of text mark).
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
476 3. Delete `.' at beginning of line."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
477 (save-excursion
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
478 (set-buffer nntp-server-buffer)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
479 ;; Insert newline at end of buffer.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
480 (goto-char (point-max))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
481 (if (not (bolp))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
482 (insert "\n"))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
483 ;; Delete status line.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
484 (goto-char (point-min))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
485 (delete-region (point) (progn (forward-line 1) (point)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
486 ;; Delete `^M' at end of line.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
487 ;; (replace-regexp "\r$" "")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
488 (while (not (eobp))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
489 (end-of-line)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
490 (if (= (preceding-char) ?\r)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
491 (delete-char -1))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
492 (forward-line 1)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
493 )
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
494 ;; Delete `.' at end of buffer (end of text mark).
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
495 (goto-char (point-max))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
496 (forward-line -1) ;(beginning-of-line)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
497 (if (looking-at "^\\.$")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
498 (delete-region (point) (progn (forward-line 1) (point))))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
499 ;; Replace `..' at beginning of line with `.'.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
500 (goto-char (point-min))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
501 ;; (replace-regexp "^\\.\\." ".")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
502 (while (search-forward "\n.." nil t)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
503 (delete-char -1))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
504 ))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
505
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
506 (defun nntp-encode-text ()
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
507 "Encode text in current buffer for NNTP transmission.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
508 1. Insert `.' at beginning of line.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
509 2. Insert `.' at end of buffer (end of text mark)."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
510 (save-excursion
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
511 ;; Insert newline at end of buffer.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
512 (goto-char (point-max))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
513 (if (not (bolp))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
514 (insert "\n"))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
515 ;; Replace `.' at beginning of line with `..'.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
516 (goto-char (point-min))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
517 ;; (replace-regexp "^\\." "..")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
518 (while (search-forward "\n." nil t)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
519 (insert "."))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
520 ;; Insert `.' at end of buffer (end of text mark).
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
521 (goto-char (point-max))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
522 (insert ".\n")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
523 ))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
524
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
525
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
526 ;;;
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
527 ;;; Synchronous Communication with NNTP Server.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
528 ;;;
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
529
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
530 (defun nntp-send-command (response cmd &rest args)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
531 "Wait for server RESPONSE after sending CMD and optional ARGS to server."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
532 (save-excursion
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
533 ;; Clear communication buffer.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
534 (set-buffer nntp-server-buffer)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
535 (erase-buffer)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
536 (apply 'nntp-send-strings-to-server cmd args)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
537 (if response
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
538 (nntp-wait-for-response response)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
539 t)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
540 ))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
541
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
542 (defun nntp-wait-for-response (regexp)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
543 "Wait for server response which matches REGEXP."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
544 (save-excursion
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
545 (let ((status t)
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
546 (wait t)
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
547 (dotnum 0) ;Number of "." being displayed.
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
548 (dotsize ;How often "." displayed.
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
549 (if (numberp nntp-debug-read) nntp-debug-read 10000)))
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
550 (set-buffer nntp-server-buffer)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
551 ;; Wait for status response (RFC977).
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
552 ;; 1xx - Informative message.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
553 ;; 2xx - Command ok.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
554 ;; 3xx - Command ok so far, send the rest of it.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
555 ;; 4xx - Command was correct, but couldn't be performed for some
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
556 ;; reason.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
557 ;; 5xx - Command unimplemented, or incorrect, or a serious
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
558 ;; program error occurred.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
559 (nntp-accept-response)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
560 (while wait
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
561 (goto-char (point-min))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
562 (cond ((looking-at "[23]")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
563 (setq wait nil))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
564 ((looking-at "[45]")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
565 (setq status nil)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
566 (setq wait nil))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
567 (t (nntp-accept-response))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
568 ))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
569 ;; Save status message.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
570 (end-of-line)
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
571 (setq nntp-status-string
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
572 (buffer-substring (point-min) (point)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
573 (if status
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
574 (progn
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
575 (setq wait t)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
576 (while wait
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
577 (goto-char (point-max))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
578 (forward-line -1) ;(beginning-of-line)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
579 ;;(message (buffer-substring
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
580 ;; (point)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
581 ;; (save-excursion (end-of-line) (point))))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
582 (if (looking-at regexp)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
583 (setq wait nil)
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
584 (if nntp-debug-read
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
585 (let ((newnum (/ (buffer-size) dotsize)))
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
586 (if (not (= dotnum newnum))
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
587 (progn
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
588 (setq dotnum newnum)
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
589 (message "NNTP: Reading %s"
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
590 (make-string dotnum ?.))))))
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
591 (nntp-accept-response)
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
592 ;;(if nntp-debug-read (message ""))
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
593 ))
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
594 ;; Remove "...".
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
595 (if (and nntp-debug-read (> dotnum 0))
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
596 (message ""))
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
597 ;; Successfully received server response.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
598 t
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
599 ))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
600 )))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
601
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
602
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
603 ;;;
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
604 ;;; Low-Level Interface to NNTP Server.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
605 ;;;
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
606
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
607 (defun nntp-send-strings-to-server (&rest strings)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
608 "Send list of STRINGS to news server as command and its arguments."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
609 (let ((cmd (car strings))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
610 (strings (cdr strings)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
611 ;; Command and each argument must be separeted by one or more spaces.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
612 (while strings
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
613 (setq cmd (concat cmd " " (car strings)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
614 (setq strings (cdr strings)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
615 ;; Command line must be terminated by a CR-LF.
2843
cd90d49526ae Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents: 882
diff changeset
616 (process-send-string nntp-server-process (concat cmd "\r\n"))
87
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
617 ))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
618
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
619 (defun nntp-send-region-to-server (begin end)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
620 "Send current buffer region (from BEGIN to END) to news server."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
621 (save-excursion
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
622 ;; We have to work in the buffer associated with NNTP server
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
623 ;; process because of NEmacs hack.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
624 (copy-to-buffer nntp-server-buffer begin end)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
625 (set-buffer nntp-server-buffer)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
626 (setq begin (point-min))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
627 (setq end (point-max))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
628 ;; `process-send-region' does not work if text to be sent is very
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
629 ;; large. I don't know maximum size of text sent correctly.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
630 (let ((last nil)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
631 (size 100)) ;Size of text sent at once.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
632 (save-restriction
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
633 (narrow-to-region begin end)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
634 (goto-char begin)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
635 (while (not (eobp))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
636 ;;(setq last (min end (+ (point) size)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
637 ;; NEmacs gets confused if character at `last' is Kanji.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
638 (setq last (save-excursion
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
639 (goto-char (min end (+ (point) size)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
640 (or (eobp) (forward-char 1)) ;Adjust point
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
641 (point)))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
642 (process-send-region nntp-server-process (point) last)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
643 ;; I don't know whether the next codes solve the known
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
644 ;; problem of communication error of GNU Emacs.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
645 (accept-process-output)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
646 ;;(sit-for 0)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
647 (goto-char last)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
648 )))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
649 ;; We cannot erase buffer, because reply may be received.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
650 (delete-region begin end)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
651 ))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
652
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
653 (defun nntp-open-server-internal (host &optional service)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
654 "Open connection to news server on HOST by SERVICE (default is nntp)."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
655 (save-excursion
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
656 ;; Use TCP/IP stream emulation package if needed.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
657 (or (fboundp 'open-network-stream)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
658 (require 'tcp))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
659 ;; Initialize communication buffer.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
660 (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
661 (set-buffer nntp-server-buffer)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
662 (buffer-flush-undo (current-buffer))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
663 (erase-buffer)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
664 (kill-all-local-variables)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
665 (setq case-fold-search t) ;Should ignore case.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
666 (setq nntp-server-process
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
667 (open-network-stream "nntpd" (current-buffer)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
668 host (or service "nntp")))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
669 (setq nntp-server-name host)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
670 ;; It is possible to change kanji-fileio-code in this hook.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
671 (run-hooks 'nntp-server-hook)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
672 ;; Return the server process.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
673 nntp-server-process
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
674 ))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
675
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
676 (defun nntp-close-server-internal ()
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
677 "Close connection to news server."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
678 (if nntp-server-process
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
679 (delete-process nntp-server-process))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
680 (if nntp-server-buffer
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
681 (kill-buffer nntp-server-buffer))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
682 (setq nntp-server-buffer nil)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
683 (setq nntp-server-process nil))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
684
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
685 (defun nntp-accept-response ()
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
686 "Read response of server.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
687 It is well-known that the communication speed will be much improved by
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
688 defining this function as macro."
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
689 ;; To deal with server process exiting before
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
690 ;; accept-process-output is called.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
691 ;; Suggested by Jason Venner <jason@violet.berkeley.edu>.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
692 ;; This is a copy of `nntp-default-sentinel'.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
693 (or (memq (process-status nntp-server-process) '(open run))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
694 (error "NNTP: Connection closed."))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
695 (if nntp-buggy-select
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
696 (progn
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
697 ;; We cannot use `accept-process-output'.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
698 ;; Fujitsu UTS requires messages during sleep-for. I don't know why.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
699 (message "NNTP: Reading...")
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
700 (sleep-for 1)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
701 (message ""))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
702 (condition-case errorcode
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
703 (accept-process-output nntp-server-process)
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
704 (error
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
705 (cond ((string-equal "select error: Invalid argument" (nth 1 errorcode))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
706 ;; Ignore select error.
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
707 nil
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
708 )
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
709 (t
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
710 (signal (car errorcode) (cdr errorcode))))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
711 ))
d39407c00c09 Initial revision
root <root>
parents:
diff changeset
712 ))
584
4cd7543be581 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 232
diff changeset
713
4cd7543be581 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 232
diff changeset
714 (provide 'nntp)
4cd7543be581 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 232
diff changeset
715
659
505130d1ddf8 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
716 ;;; nntp.el ends here