05328297 |
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 | \f |
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 | \f |
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 () |
a0963566 |
411 | "Set current article pointer to the previous article in the current news group." |
05328297 |
412 | (nntp-send-command "^[23].*\r$" "LAST")) |
413 | |
414 | (defun nntp-request-next () |
415 | "Advance current article pointer." |
416 | (nntp-send-command "^[23].*\r$" "NEXT")) |
417 | |
418 | (defun nntp-request-post () |
419 | "Post a new news in current buffer." |
420 | (if (nntp-send-command "^[23].*\r$" "POST") |
421 | (progn |
422 | (nntp-encode-text) |
423 | (nntp-send-region-to-server (point-min) (point-max)) |
424 | ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not |
425 | ;; appended to end of the status message. |
426 | (nntp-wait-for-response "^[23].*$") |
427 | ))) |
428 | |
429 | (defun nntp-default-sentinel (proc status) |
430 | "Default sentinel function for NNTP server process." |
431 | (if (and nntp-server-process |
432 | (not (nntp-server-opened))) |
433 | (error "NNTP: Connection closed.") |
434 | )) |
435 | |
436 | ;; Encoding and decoding of NNTP text. |
437 | |
438 | (defun nntp-decode-text () |
439 | "Decode text transmitted by NNTP. |
440 | 0. Delete status line. |
441 | 1. Delete `^M' at end of line. |
442 | 2. Delete `.' at end of buffer (end of text mark). |
443 | 3. Delete `.' at beginning of line." |
444 | (save-excursion |
445 | (set-buffer nntp-server-buffer) |
446 | ;; Insert newline at end of buffer. |
447 | (goto-char (point-max)) |
448 | (if (not (bolp)) |
449 | (insert "\n")) |
450 | ;; Delete status line. |
451 | (goto-char (point-min)) |
452 | (delete-region (point) (progn (forward-line 1) (point))) |
453 | ;; Delete `^M' at end of line. |
454 | ;; (replace-regexp "\r$" "") |
455 | (while (not (eobp)) |
456 | (end-of-line) |
457 | (if (= (preceding-char) ?\r) |
458 | (delete-char -1)) |
459 | (forward-line 1) |
460 | ) |
461 | ;; Delete `.' at end of buffer (end of text mark). |
462 | (goto-char (point-max)) |
463 | (forward-line -1) ;(beginning-of-line) |
464 | (if (looking-at "^\\.$") |
465 | (delete-region (point) (progn (forward-line 1) (point)))) |
466 | ;; Replace `..' at beginning of line with `.'. |
467 | (goto-char (point-min)) |
468 | ;; (replace-regexp "^\\.\\." ".") |
469 | (while (search-forward "\n.." nil t) |
470 | (delete-char -1)) |
471 | )) |
472 | |
473 | (defun nntp-encode-text () |
474 | "Encode text in current buffer for NNTP transmission. |
475 | 1. Insert `.' at beginning of line. |
476 | 2. Insert `.' at end of buffer (end of text mark)." |
477 | (save-excursion |
478 | ;; Insert newline at end of buffer. |
479 | (goto-char (point-max)) |
480 | (if (not (bolp)) |
481 | (insert "\n")) |
482 | ;; Replace `.' at beginning of line with `..'. |
483 | (goto-char (point-min)) |
484 | ;; (replace-regexp "^\\." "..") |
485 | (while (search-forward "\n." nil t) |
486 | (insert ".")) |
487 | ;; Insert `.' at end of buffer (end of text mark). |
488 | (goto-char (point-max)) |
489 | (insert ".\n") |
490 | )) |
491 | |
492 | \f |
493 | ;;; |
494 | ;;; Synchronous Communication with NNTP Server. |
495 | ;;; |
496 | |
497 | (defun nntp-send-command (response cmd &rest args) |
498 | "Wait for server RESPONSE after sending CMD and optional ARGS to server." |
499 | (save-excursion |
500 | ;; Clear communication buffer. |
501 | (set-buffer nntp-server-buffer) |
502 | (erase-buffer) |
503 | (apply 'nntp-send-strings-to-server cmd args) |
504 | (if response |
505 | (nntp-wait-for-response response) |
506 | t) |
507 | )) |
508 | |
509 | (defun nntp-wait-for-response (regexp) |
510 | "Wait for server response which matches REGEXP." |
511 | (save-excursion |
512 | (let ((status t) |
513 | (wait t)) |
514 | (set-buffer nntp-server-buffer) |
515 | ;; Wait for status response (RFC977). |
516 | ;; 1xx - Informative message. |
517 | ;; 2xx - Command ok. |
518 | ;; 3xx - Command ok so far, send the rest of it. |
519 | ;; 4xx - Command was correct, but couldn't be performed for some |
520 | ;; reason. |
521 | ;; 5xx - Command unimplemented, or incorrect, or a serious |
522 | ;; program error occurred. |
523 | (nntp-accept-response) |
524 | (while wait |
525 | (goto-char (point-min)) |
526 | (cond ((looking-at "[23]") |
527 | (setq wait nil)) |
528 | ((looking-at "[45]") |
529 | (setq status nil) |
530 | (setq wait nil)) |
531 | (t (nntp-accept-response)) |
532 | )) |
533 | ;; Save status message. |
534 | (end-of-line) |
535 | (setq nntp-status-message-string |
536 | (buffer-substring (point-min) (point))) |
537 | (if status |
538 | (progn |
539 | (setq wait t) |
540 | (while wait |
541 | (goto-char (point-max)) |
542 | (forward-line -1) ;(beginning-of-line) |
543 | ;;(message (buffer-substring |
544 | ;; (point) |
545 | ;; (save-excursion (end-of-line) (point)))) |
546 | (if (looking-at regexp) |
547 | (setq wait nil) |
548 | (message "NNTP: Reading...") |
549 | (nntp-accept-response) |
550 | (message "") |
551 | )) |
552 | ;; Successfully received server response. |
553 | t |
554 | )) |
555 | ))) |
556 | |
557 | \f |
558 | ;;; |
559 | ;;; Low-Level Interface to NNTP Server. |
560 | ;;; |
561 | |
562 | (defun nntp-send-strings-to-server (&rest strings) |
563 | "Send list of STRINGS to news server as command and its arguments." |
564 | (let ((cmd (car strings)) |
565 | (strings (cdr strings))) |
566 | ;; Command and each argument must be separeted by one or more spaces. |
567 | (while strings |
568 | (setq cmd (concat cmd " " (car strings))) |
569 | (setq strings (cdr strings))) |
570 | ;; Command line must be terminated by a CR-LF. |
571 | (process-send-string nntp-server-process (concat cmd "\n")) |
572 | )) |
573 | |
574 | (defun nntp-send-region-to-server (begin end) |
575 | "Send current buffer region (from BEGIN to END) to news server." |
576 | (save-excursion |
577 | ;; We have to work in the buffer associated with NNTP server |
578 | ;; process because of NEmacs hack. |
579 | (copy-to-buffer nntp-server-buffer begin end) |
580 | (set-buffer nntp-server-buffer) |
581 | (setq begin (point-min)) |
582 | (setq end (point-max)) |
583 | ;; `process-send-region' does not work if text to be sent is very |
584 | ;; large. I don't know maximum size of text sent correctly. |
585 | (let ((last nil) |
586 | (size 100)) ;Size of text sent at once. |
587 | (save-restriction |
588 | (narrow-to-region begin end) |
589 | (goto-char begin) |
590 | (while (not (eobp)) |
591 | ;;(setq last (min end (+ (point) size))) |
592 | ;; NEmacs gets confused if character at `last' is Kanji. |
593 | (setq last (save-excursion |
594 | (goto-char (min end (+ (point) size))) |
595 | (or (eobp) (forward-char 1)) ;Adjust point |
596 | (point))) |
597 | (process-send-region nntp-server-process (point) last) |
598 | ;; I don't know whether the next codes solve the known |
599 | ;; problem of communication error of GNU Emacs. |
600 | (accept-process-output) |
601 | ;;(sit-for 0) |
602 | (goto-char last) |
603 | ))) |
604 | ;; We cannot erase buffer, because reply may be received. |
605 | (delete-region begin end) |
606 | )) |
607 | |
608 | (defun nntp-open-server-internal (host &optional service) |
609 | "Open connection to news server on HOST by SERVICE (default is nntp)." |
610 | (save-excursion |
611 | ;; Use TCP/IP stream emulation package if needed. |
612 | (or (fboundp 'open-network-stream) |
613 | (require 'tcp)) |
614 | ;; Initialize communication buffer. |
615 | (setq nntp-server-buffer (get-buffer-create " *nntpd*")) |
616 | (set-buffer nntp-server-buffer) |
617 | (buffer-flush-undo (current-buffer)) |
618 | (erase-buffer) |
619 | (kill-all-local-variables) |
620 | (setq case-fold-search t) ;Should ignore case. |
621 | (setq nntp-server-process |
622 | (open-network-stream "nntpd" (current-buffer) |
623 | host (or service "nntp"))) |
624 | (setq nntp-server-name host) |
625 | ;; It is possible to change kanji-fileio-code in this hook. |
626 | (run-hooks 'nntp-server-hook) |
627 | ;; Return the server process. |
628 | nntp-server-process |
629 | )) |
630 | |
631 | (defun nntp-close-server-internal () |
632 | "Close connection to news server." |
633 | (if nntp-server-process |
634 | (delete-process nntp-server-process)) |
635 | (if nntp-server-buffer |
636 | (kill-buffer nntp-server-buffer)) |
637 | (setq nntp-server-buffer nil) |
638 | (setq nntp-server-process nil)) |
639 | |
640 | (defun nntp-accept-response () |
641 | "Read response of server. |
642 | It is well-known that the communication speed will be much improved by |
643 | defining this function as macro." |
644 | ;; To deal with server process exiting before |
645 | ;; accept-process-output is called. |
646 | ;; Suggested by Jason Venner <jason@violet.berkeley.edu>. |
647 | ;; This is a copy of `nntp-default-sentinel'. |
648 | (or (memq (process-status nntp-server-process) '(open run)) |
649 | (error "NNTP: Connection closed.")) |
650 | (if nntp-buggy-select |
651 | (progn |
652 | ;; We cannot use `accept-process-output'. |
653 | ;; Fujitsu UTS requires messages during sleep-for. I don't know why. |
654 | (message "NNTP: Reading...") |
655 | (sleep-for 1) |
656 | (message "")) |
657 | (condition-case errorcode |
658 | (accept-process-output nntp-server-process) |
659 | (error |
660 | (cond ((string-equal "select error: Invalid argument" (nth 1 errorcode)) |
661 | ;; Ignore select error. |
662 | nil |
663 | ) |
664 | (t |
665 | (signal (car errorcode) (cdr errorcode)))) |
666 | )) |
667 | )) |