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