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