Mercurial > emacs
annotate lisp/nntp.el @ 14108:cab8d383f10d
(easy-menu-define): Doc fix.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Tue, 09 Jan 1996 23:16:13 +0000 |
parents | 187735b53d52 |
children | 83f275dcd93a |
rev | line source |
---|---|
13401 | 1 ;;; nntp.el --- nntp access for Gnus |
2 ;; Copyright (C) 1987,88,89,90,92,93,94,95 Free Software Foundation, Inc. | |
3 | |
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> | |
5 ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no> | |
6 ;; Keywords: news | |
7 | |
8 ;; This file is part of GNU Emacs. | |
9 | |
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. | |
14 | |
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 | |
24 ;;; Commentary: | |
25 | |
26 ;;; Code: | |
27 | |
28 (require 'rnews) | |
29 (require 'sendmail) | |
30 (require 'nnheader) | |
31 | |
32 (eval-when-compile (require 'cl)) | |
33 | |
34 (eval-and-compile | |
35 (autoload 'news-setup "rnewspost") | |
36 (autoload 'news-reply-mode "rnewspost") | |
37 (autoload 'nnmail-request-post-buffer "nnmail") | |
38 (autoload 'cancel-timer "timer") | |
39 (autoload 'telnet "telnet" nil t) | |
40 (autoload 'telnet-send-input "telnet" nil t) | |
41 (autoload 'timezone-parse-date "timezone")) | |
42 | |
43 (defvar nntp-server-hook nil | |
44 "*Hooks for the NNTP server. | |
45 If the kanji code of the NNTP server is different from the local kanji | |
46 code, the correct kanji code of the buffer associated with the NNTP | |
47 server must be specified as follows: | |
48 | |
49 \(setq nntp-server-hook | |
50 (function | |
51 (lambda () | |
52 ;; Server's Kanji code is EUC (NEmacs hack). | |
53 (make-local-variable 'kanji-fileio-code) | |
54 (setq kanji-fileio-code 0)))) | |
55 | |
56 If you'd like to change something depending on the server in this | |
57 hook, use the variable `nntp-address'.") | |
58 | |
59 (defvar nntp-server-opened-hook nil | |
60 "*Hook used for sending commands to the server at startup. | |
61 The default value is `nntp-send-mode-reader', which makes an innd | |
62 server spawn an nnrpd server. Another useful function to put in this | |
63 hook might be `nntp-send-authinfo', which will prompt for a password | |
64 to allow posting from the server. Note that this is only necessary to | |
65 do on servers that use strict access control.") | |
66 (add-hook 'nntp-server-opened-hook 'nntp-send-mode-reader) | |
67 | |
68 (defvar nntp-open-server-function 'nntp-open-network-stream | |
69 "*Function used for connecting to a remote system. | |
70 It will be called with the address of the remote system. | |
71 | |
72 Two pre-made functions are `nntp-open-network-stream', which is the | |
73 default, and simply connects to some port or other on the remote | |
74 system (see nntp-port-number). The other is `nntp-open-rlogin', which | |
75 does an rlogin on the remote system, and then does a telnet to the | |
76 NNTP server available there (see nntp-rlogin-parameters).") | |
77 | |
78 (defvar nntp-rlogin-parameters '("telnet" "${NNTPSERVER:=localhost}" "nntp") | |
79 "*Parameters to `nntp-open-login'. | |
80 That function may be used as `nntp-open-server-function'. In that | |
81 case, this list will be used as the parameter list given to rsh.") | |
82 | |
83 (defvar nntp-rlogin-user-name nil | |
84 "*User name on remote system when using the rlogin connect method.") | |
85 | |
86 (defvar nntp-address nil | |
87 "*The name of the NNTP server.") | |
88 | |
89 (defvar nntp-port-number "nntp" | |
90 "*Port number to connect to.") | |
91 | |
92 (defvar nntp-large-newsgroup 50 | |
93 "*The number of the articles which indicates a large newsgroup. | |
94 If the number of the articles is greater than the value, verbose | |
95 messages will be shown to indicate the current status.") | |
96 | |
97 (defvar nntp-buggy-select (memq system-type '(fujitsu-uts)) | |
98 "*t if your select routine is buggy. | |
99 If the select routine signals error or fall into infinite loop while | |
100 waiting for the server response, the variable must be set to t. In | |
101 case of Fujitsu UTS, it is set to T since `accept-process-output' | |
102 doesn't work properly.") | |
103 | |
104 (defvar nntp-maximum-request 400 | |
105 "*The maximum number of the requests sent to the NNTP server at one time. | |
106 If Emacs hangs up while retrieving headers, set the variable to a | |
107 lower value.") | |
108 | |
109 (defvar nntp-debug-read 10000 | |
110 "*Display '...' every 10Kbytes of a message being received if it is non-nil. | |
111 If it is a number, dots are displayed per the number.") | |
112 | |
113 (defvar nntp-nov-is-evil nil | |
114 "*If non-nil, nntp will never attempt to use XOVER when talking to the server.") | |
115 | |
116 (defvar nntp-xover-commands '("XOVER" "XOVERVIEW") | |
117 "*List of strings that are used as commands to fetch NOV lines from a server. | |
118 The strings are tried in turn until a positive response is gotten. If | |
119 none of the commands are successful, nntp will just grab headers one | |
120 by one.") | |
121 | |
122 (defvar nntp-nov-gap 20 | |
123 "*Maximum allowed gap between two articles. | |
124 If the gap between two consecutive articles is bigger than this | |
125 variable, split the XOVER request into two requests.") | |
126 | |
127 (defvar nntp-connection-timeout nil | |
128 "*Number of seconds to wait before an nntp connection times out. | |
129 If this variable is nil, which is the default, no timers are set.") | |
130 | |
131 (defvar nntp-news-default-headers nil | |
132 "*If non-nil, override `mail-default-headers' when posting news.") | |
133 | |
134 (defvar nntp-prepare-server-hook nil | |
135 "*Hook run before a server is opened. | |
136 If can be used to set up a server remotely, for instance. Say you | |
137 have an account at the machine \"other.machine\". This machine has | |
138 access to an NNTP server that you can't access locally. You could | |
139 then use this hook to rsh to the remote machine and start a proxy NNTP | |
140 server there that you can connect to.") | |
141 | |
142 (defvar nntp-async-number 5 | |
143 "*How many articles should be prefetched when in asynchronous mode.") | |
144 | |
145 | |
146 | |
147 | |
148 (defconst nntp-version "nntp 4.0" | |
149 "Version numbers of this version of NNTP.") | |
150 | |
151 (defvar nntp-server-buffer nil | |
152 "Buffer associated with the NNTP server process.") | |
153 | |
154 (defvar nntp-server-process nil | |
155 "The NNTP server process. | |
156 You'd better not use this variable in NNTP front-end program, but | |
157 instead use `nntp-server-buffer'.") | |
158 | |
159 (defvar nntp-status-string nil | |
160 "Save the server response message. | |
161 You'd better not use this variable in NNTP front-end program but | |
162 instead call function `nntp-status-message' to get status message.") | |
163 | |
164 (defvar nntp-opened-connections nil | |
165 "All (possibly) opened connections.") | |
166 | |
167 (defvar nntp-server-xover 'try) | |
168 (defvar nntp-server-list-active-group 'try) | |
169 (defvar nntp-current-group "") | |
170 (defvar nntp-timeout-servers nil) | |
171 | |
172 (defvar nntp-async-process nil) | |
173 (defvar nntp-async-buffer nil) | |
174 (defvar nntp-async-articles nil) | |
175 (defvar nntp-async-fetched nil) | |
176 (defvar nntp-async-group-alist nil) | |
177 | |
178 | |
179 | |
180 (defvar nntp-current-server nil) | |
181 (defvar nntp-server-alist nil) | |
182 (defvar nntp-server-variables | |
183 (list | |
184 (list 'nntp-server-hook nntp-server-hook) | |
185 (list 'nntp-server-opened-hook nntp-server-opened-hook) | |
186 (list 'nntp-port-number nntp-port-number) | |
187 (list 'nntp-address nntp-address) | |
188 (list 'nntp-large-newsgroup nntp-large-newsgroup) | |
189 (list 'nntp-buggy-select nntp-buggy-select) | |
190 (list 'nntp-maximum-request nntp-maximum-request) | |
191 (list 'nntp-debug-read nntp-debug-read) | |
192 (list 'nntp-nov-is-evil nntp-nov-is-evil) | |
193 (list 'nntp-xover-commands nntp-xover-commands) | |
194 (list 'nntp-connection-timeout nntp-connection-timeout) | |
195 (list 'nntp-news-default-headers nntp-news-default-headers) | |
196 (list 'nntp-prepare-server-hook nntp-prepare-server-hook) | |
197 (list 'nntp-async-number nntp-async-number) | |
198 '(nntp-async-process nil) | |
199 '(nntp-async-buffer nil) | |
200 '(nntp-async-articles nil) | |
201 '(nntp-async-fetched nil) | |
202 '(nntp-async-group-alist nil) | |
203 '(nntp-server-process nil) | |
204 '(nntp-status-string nil) | |
205 '(nntp-server-xover try) | |
206 '(nntp-server-list-active-group try) | |
207 '(nntp-current-group ""))) | |
208 | |
209 | |
210 ;;; Interface functions. | |
211 | |
212 (defun nntp-retrieve-headers (sequence &optional newsgroup server) | |
213 "Retrieve the headers to the articles in SEQUENCE." | |
214 (nntp-possibly-change-server newsgroup server) | |
215 (save-excursion | |
216 (set-buffer nntp-server-buffer) | |
217 (erase-buffer) | |
218 (if (and (not gnus-nov-is-evil) | |
219 (not nntp-nov-is-evil) | |
220 (nntp-retrieve-headers-with-xover sequence)) | |
221 'nov | |
222 (let ((number (length sequence)) | |
223 (count 0) | |
224 (received 0) | |
225 (last-point (point-min))) | |
226 ;; Send HEAD command. | |
227 (while sequence | |
228 (nntp-send-strings-to-server | |
229 "HEAD" (if (numberp (car sequence)) (int-to-string (car sequence)) | |
230 (car sequence))) | |
231 (setq sequence (cdr sequence) | |
232 count (1+ count)) | |
233 ;; Every 400 header requests we have to read stream in order | |
234 ;; to avoid deadlock. | |
235 (if (or (null sequence) ;All requests have been sent. | |
236 (zerop (% count nntp-maximum-request))) | |
237 (progn | |
238 (nntp-accept-response) | |
239 (while (progn | |
240 (goto-char last-point) | |
241 ;; Count replies. | |
242 (while (re-search-forward "^[0-9]" nil t) | |
243 (setq received (1+ received))) | |
244 (setq last-point (point)) | |
245 (< received count)) | |
246 ;; If number of headers is greater than 100, give | |
247 ;; informative messages. | |
248 (and (numberp nntp-large-newsgroup) | |
249 (> number nntp-large-newsgroup) | |
250 (zerop (% received 20)) | |
251 (message "NNTP: Receiving headers... %d%%" | |
252 (/ (* received 100) number))) | |
253 (nntp-accept-response))))) | |
254 ;; Wait for text of last command. | |
255 (goto-char (point-max)) | |
256 (re-search-backward "^[0-9]" nil t) | |
257 (if (looking-at "^[23]") | |
258 (while (progn | |
259 (goto-char (- (point-max) 3)) | |
260 (not (looking-at "^\\.\r?\n"))) | |
261 (nntp-accept-response))) | |
262 (and (numberp nntp-large-newsgroup) | |
263 (> number nntp-large-newsgroup) | |
264 (message "NNTP: Receiving headers...done")) | |
265 | |
266 ;; Now all of replies are received. | |
267 (setq received number) | |
268 ;; First, fold continuation lines. | |
269 (goto-char (point-min)) | |
270 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) | |
271 (replace-match " ")) | |
272 ;; Remove all "\r"'s | |
273 (goto-char (point-min)) | |
274 (while (search-forward "\r" nil t) | |
275 (replace-match "")) | |
276 'headers)))) | |
277 | |
278 | |
279 (defun nntp-retrieve-groups (groups &optional server) | |
280 (nntp-possibly-change-server nil server) | |
281 (save-excursion | |
282 (set-buffer nntp-server-buffer) | |
283 (and (eq nntp-server-list-active-group 'try) | |
284 (nntp-try-list-active (car groups))) | |
285 (erase-buffer) | |
286 (let ((count 0) | |
287 (received 0) | |
288 (last-point (point-min)) | |
289 (command (if nntp-server-list-active-group | |
290 "LIST ACTIVE" "GROUP"))) | |
291 (while groups | |
292 (nntp-send-strings-to-server command (car groups)) | |
293 (setq groups (cdr groups)) | |
294 (setq count (1+ count)) | |
295 ;; Every 400 requests we have to read the stream in | |
296 ;; order to avoid deadlocks. | |
297 (if (or (null groups) ;All requests have been sent. | |
298 (zerop (% count nntp-maximum-request))) | |
299 (progn | |
300 (nntp-accept-response) | |
301 (while (progn | |
302 (goto-char last-point) | |
303 ;; Count replies. | |
304 (while (re-search-forward "^[0-9]" nil t) | |
305 (setq received (1+ received))) | |
306 (setq last-point (point)) | |
307 (< received count)) | |
308 (nntp-accept-response))))) | |
309 | |
310 ;; Wait for the reply from the final command. | |
311 (if nntp-server-list-active-group | |
312 (progn | |
313 (goto-char (point-max)) | |
314 (re-search-backward "^[0-9]" nil t) | |
315 (if (looking-at "^[23]") | |
316 (while (progn | |
317 (goto-char (- (point-max) 3)) | |
318 (not (looking-at "^\\.\r?\n"))) | |
319 (nntp-accept-response))))) | |
320 | |
321 ;; Now all replies are received. We remove CRs. | |
322 (goto-char (point-min)) | |
323 (while (search-forward "\r" nil t) | |
324 (replace-match "" t t)) | |
325 | |
326 (if nntp-server-list-active-group | |
327 (progn | |
328 ;; We have read active entries, so we just delete the | |
14040 | 329 ;; superfluous gunk. |
13401 | 330 (goto-char (point-min)) |
331 (while (re-search-forward "^[.2-5]" nil t) | |
332 (delete-region (match-beginning 0) | |
333 (progn (forward-line 1) (point)))) | |
334 'active) | |
335 'group)))) | |
336 | |
13588
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
337 (defun nntp-open-server (server &optional defs connectionless) |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
338 "Open the virtual server SERVER. |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
339 If CONNECTIONLESS is non-nil, don't attempt to connect to any physical |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
340 servers." |
13401 | 341 (nnheader-init-server-buffer) |
342 (if (nntp-server-opened server) | |
343 t | |
344 (if (or (stringp (car defs)) | |
345 (numberp (car defs))) | |
346 (setq defs (cons (list 'nntp-port-number (car defs)) (cdr defs)))) | |
347 (or (assq 'nntp-address defs) | |
348 (setq defs (append defs (list (list 'nntp-address server))))) | |
349 (if (and nntp-current-server | |
350 (not (equal server nntp-current-server))) | |
351 (setq nntp-server-alist | |
352 (cons (list nntp-current-server | |
353 (nnheader-save-variables nntp-server-variables)) | |
354 nntp-server-alist))) | |
355 (let ((state (assoc server nntp-server-alist))) | |
356 (if state | |
357 (progn | |
358 (nnheader-restore-variables (nth 1 state)) | |
359 (setq nntp-server-alist (delq state nntp-server-alist))) | |
360 (nnheader-set-init-variables nntp-server-variables defs))) | |
361 (setq nntp-current-server server) | |
13588
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
362 ;; We have now changed to the proper virtual server. We then |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
363 ;; check that the physical server is opened. |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
364 (if (or (nntp-server-opened server) |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
365 connectionless) |
13741
9b68e9a5cae1
* nntp.el (nntp-open-server): Enable successful "connectionless"
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
13588
diff
changeset
|
366 t |
13588
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
367 (if (member nntp-address nntp-timeout-servers) |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
368 nil |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
369 ;; We open a connection to the physical nntp server. |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
370 (run-hooks 'nntp-prepare-server-hook) |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
371 (nntp-open-server-semi-internal nntp-address nntp-port-number))))) |
13401 | 372 |
373 (defun nntp-close-server (&optional server) | |
374 "Close connection to SERVER." | |
13588
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
375 (nntp-possibly-change-server nil server t) |
13401 | 376 (unwind-protect |
377 (progn | |
378 ;; Un-set default sentinel function before closing connection. | |
379 (and nntp-server-process | |
380 (eq 'nntp-default-sentinel | |
381 (process-sentinel nntp-server-process)) | |
382 (set-process-sentinel nntp-server-process nil)) | |
383 ;; We cannot send QUIT command unless the process is running. | |
384 (if (nntp-server-opened) | |
385 (nntp-send-command nil "QUIT"))) | |
386 (nntp-close-server-internal server) | |
387 (setq nntp-timeout-servers (delete server nntp-timeout-servers)))) | |
388 | |
389 (defalias 'nntp-request-quit (symbol-function 'nntp-close-server)) | |
390 | |
391 (defun nntp-request-close () | |
392 "Close all server connections." | |
393 (let (proc) | |
394 (while nntp-opened-connections | |
395 (setq proc (pop nntp-opened-connections)) | |
396 (and proc (delete-process proc))) | |
397 (and nntp-async-buffer | |
398 (get-buffer nntp-async-buffer) | |
399 (kill-buffer nntp-async-buffer)) | |
400 (while nntp-server-alist | |
401 (and (setq proc (nth 1 (assq 'nntp-async-buffer | |
402 (car nntp-server-alist)))) | |
403 (buffer-name proc) | |
404 (kill-buffer proc)) | |
405 (setq nntp-server-alist (cdr nntp-server-alist))) | |
406 (setq nntp-current-server nil | |
407 nntp-timeout-servers nil | |
408 nntp-async-group-alist nil))) | |
409 | |
410 (defun nntp-server-opened (&optional server) | |
411 "Say whether a connection to SERVER has been opened." | |
412 (and (equal server nntp-current-server) | |
413 nntp-server-buffer | |
414 (buffer-name nntp-server-buffer) | |
415 nntp-server-process | |
416 (memq (process-status nntp-server-process) '(open run)))) | |
417 | |
418 (defun nntp-status-message (&optional server) | |
419 "Return server status as a string." | |
420 (if (and nntp-status-string | |
421 ;; NNN MESSAGE | |
422 (string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$" | |
423 nntp-status-string)) | |
424 (substring nntp-status-string (match-beginning 1) (match-end 1)) | |
425 ;; Empty message if nothing. | |
426 (or nntp-status-string ""))) | |
427 | |
428 (defun nntp-request-article (id &optional newsgroup server buffer) | |
429 "Request article ID (message-id or number)." | |
430 (nntp-possibly-change-server newsgroup server) | |
431 | |
432 (let (found) | |
433 | |
434 ;; First we see whether we can get the article from the async buffer. | |
435 (if (and (numberp id) | |
436 nntp-async-articles | |
437 (memq id nntp-async-fetched)) | |
438 (save-excursion | |
439 (set-buffer nntp-async-buffer) | |
440 (let ((opoint (point)) | |
441 (art (if (numberp id) (int-to-string id) id)) | |
442 beg end) | |
443 (if (and (or (re-search-forward (concat "^2.. +" art) nil t) | |
444 (progn | |
445 (goto-char (point-min)) | |
446 (re-search-forward (concat "^2.. +" art) opoint t))) | |
447 (progn | |
448 (beginning-of-line) | |
449 (setq beg (point) | |
450 end (re-search-forward "^\\.\r?\n" nil t)))) | |
451 (progn | |
452 (setq found t) | |
453 (save-excursion | |
454 (set-buffer (or buffer nntp-server-buffer)) | |
455 (erase-buffer) | |
456 (insert-buffer-substring nntp-async-buffer beg end) | |
457 (let ((nntp-server-buffer (current-buffer))) | |
458 (nntp-decode-text))) | |
459 (delete-region beg end) | |
460 (and nntp-async-articles | |
461 (nntp-async-fetch-articles id))))))) | |
462 | |
463 (if found | |
464 t | |
465 ;; The article was not in the async buffer, so we fetch it now. | |
466 (unwind-protect | |
467 (progn | |
468 (if buffer (set-process-buffer nntp-server-process buffer)) | |
469 (let ((nntp-server-buffer (or buffer nntp-server-buffer)) | |
470 (art (or (and (numberp id) (int-to-string id)) id))) | |
471 ;; If NEmacs, end of message may look like: "\256\215" (".^M") | |
472 (prog1 | |
473 (nntp-send-command "^\\.\r?\n" "ARTICLE" art) | |
474 (nntp-decode-text) | |
475 (and nntp-async-articles (nntp-async-fetch-articles id))))) | |
476 (if buffer (set-process-buffer | |
477 nntp-server-process nntp-server-buffer)))))) | |
478 | |
479 (defun nntp-request-body (id &optional newsgroup server) | |
480 "Request body of article ID (message-id or number)." | |
481 (nntp-possibly-change-server newsgroup server) | |
482 (prog1 | |
483 ;; If NEmacs, end of message may look like: "\256\215" (".^M") | |
484 (nntp-send-command | |
485 "^\\.\r?\n" "BODY" (or (and (numberp id) (int-to-string id)) id)) | |
486 (nntp-decode-text))) | |
487 | |
488 (defun nntp-request-head (id &optional newsgroup server) | |
489 "Request head of article ID (message-id or number)." | |
490 (nntp-possibly-change-server newsgroup server) | |
491 (prog1 | |
492 (nntp-send-command | |
493 "^\\.\r?\n" "HEAD" (or (and (numberp id) (int-to-string id)) id)) | |
494 (nntp-decode-text))) | |
495 | |
496 (defun nntp-request-stat (id &optional newsgroup server) | |
497 "Request STAT of article ID (message-id or number)." | |
498 (nntp-possibly-change-server newsgroup server) | |
499 (nntp-send-command | |
500 "^[23].*\r?\n" "STAT" (or (and (numberp id) (int-to-string id)) id))) | |
501 | |
502 (defun nntp-request-group (group &optional server dont-check) | |
503 "Select GROUP." | |
504 (nntp-send-command "^.*\r?\n" "GROUP" group) | |
505 (setq nntp-current-group group) | |
506 (save-excursion | |
507 (set-buffer nntp-server-buffer) | |
508 (goto-char (point-min)) | |
509 (looking-at "[23]"))) | |
510 | |
511 (defun nntp-request-asynchronous (group &optional server articles) | |
512 (and nntp-async-articles (nntp-async-request-group group)) | |
513 (and | |
514 nntp-async-number | |
515 (if (not (or (nntp-async-server-opened) | |
516 (nntp-async-open-server))) | |
517 (progn | |
518 (message "Can't open second connection to %s" nntp-address) | |
519 (ding) | |
520 (setq nntp-async-articles nil) | |
521 (sit-for 2)) | |
522 (setq nntp-async-articles articles) | |
523 (setq nntp-async-fetched nil) | |
524 (save-excursion | |
525 (set-buffer nntp-async-buffer) | |
526 (erase-buffer)) | |
527 (nntp-async-send-strings "GROUP" group) | |
528 t))) | |
529 | |
530 (defun nntp-list-active-group (group &optional server) | |
531 (nntp-send-command "^.*\r?\n" "LIST ACTIVE" group)) | |
532 | |
533 (defun nntp-request-group-description (group &optional server) | |
534 "Get description of GROUP." | |
13588
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
535 (nntp-possibly-change-server nil server) |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
536 (prog1 |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
537 (nntp-send-command "^.*\r?\n" "XGTITLE" group) |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
538 (nntp-decode-text))) |
13401 | 539 |
540 (defun nntp-close-group (group &optional server) | |
541 (setq nntp-current-group nil) | |
542 t) | |
543 | |
544 (defun nntp-request-list (&optional server) | |
545 "List active groups." | |
546 (nntp-possibly-change-server nil server) | |
547 (prog1 | |
548 (nntp-send-command "^\\.\r?\n" "LIST") | |
549 (nntp-decode-text))) | |
550 | |
551 (defun nntp-request-list-newsgroups (&optional server) | |
552 "List groups." | |
553 (nntp-possibly-change-server nil server) | |
554 (prog1 | |
555 (nntp-send-command "^\\.\r?\n" "LIST NEWSGROUPS") | |
556 (nntp-decode-text))) | |
557 | |
558 (defun nntp-request-newgroups (date &optional server) | |
559 "List new groups." | |
560 (nntp-possibly-change-server nil server) | |
561 (let* ((date (timezone-parse-date date)) | |
562 (time-string | |
563 (format "%s%02d%02d %s%s%s" | |
564 (substring (aref date 0) 2) (string-to-int (aref date 1)) | |
565 (string-to-int (aref date 2)) (substring (aref date 3) 0 2) | |
566 (substring | |
567 (aref date 3) 3 5) (substring (aref date 3) 6 8)))) | |
568 (prog1 | |
569 (nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string) | |
570 (nntp-decode-text)))) | |
571 | |
572 (defun nntp-request-list-distributions (&optional server) | |
573 "List distributions." | |
574 (nntp-possibly-change-server nil server) | |
575 (prog1 | |
576 (nntp-send-command "^\\.\r?\n" "LIST DISTRIBUTIONS") | |
577 (nntp-decode-text))) | |
578 | |
579 (defun nntp-request-last (&optional newsgroup server) | |
580 "Decrease the current article pointer." | |
581 (nntp-possibly-change-server newsgroup server) | |
582 (nntp-send-command "^[23].*\r?\n" "LAST")) | |
583 | |
584 (defun nntp-request-next (&optional newsgroup server) | |
585 "Advance the current article pointer." | |
586 (nntp-possibly-change-server newsgroup server) | |
587 (nntp-send-command "^[23].*\r?\n" "NEXT")) | |
588 | |
589 (defun nntp-request-post (&optional server) | |
590 "Post the current buffer." | |
591 (nntp-possibly-change-server nil server) | |
592 (if (nntp-send-command "^[23].*\r?\n" "POST") | |
593 (progn | |
594 (nntp-encode-text) | |
595 (nntp-send-region-to-server (point-min) (point-max)) | |
596 ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not | |
597 ;; appended to end of the status message. | |
598 (nntp-wait-for-response "^[23].*\n")))) | |
599 | |
600 (defun nntp-request-post-buffer | |
601 (post group subject header article-buffer info follow-to respect-poster) | |
602 "Request a buffer suitable for composing an article. | |
603 If POST, this is an original article; otherwise it's a followup. | |
604 GROUP is the group to be posted to, the article should have subject | |
605 SUBJECT. HEADER is a Gnus header vector. ARTICLE-BUFFER contains the | |
606 article being followed up. INFO is a Gnus info list. If FOLLOW-TO, | |
607 post to this group instead. If RESPECT-POSTER, heed the special | |
608 \"poster\" value of the Followup-to header." | |
609 (if (assq 'to-address (nth 5 info)) | |
610 (nnmail-request-post-buffer | |
611 post group subject header article-buffer info follow-to respect-poster) | |
612 (let ((mail-default-headers | |
613 (or nntp-news-default-headers mail-default-headers)) | |
614 from date to followup-to newsgroups message-of | |
615 references distribution message-id) | |
616 (save-excursion | |
617 (set-buffer (get-buffer-create "*post-news*")) | |
618 (news-reply-mode) | |
619 (if (and (buffer-modified-p) | |
620 (> (buffer-size) 0) | |
621 (not (y-or-n-p "Unsent article being composed; erase it? "))) | |
622 () | |
623 (erase-buffer) | |
624 (if post | |
625 (news-setup nil subject nil group nil) | |
626 (save-excursion | |
627 (set-buffer article-buffer) | |
628 (goto-char (point-min)) | |
629 (narrow-to-region (point-min) | |
630 (progn (search-forward "\n\n") (point))) | |
631 (setq from (mail-header-from header)) | |
632 (setq date (mail-header-date header)) | |
633 (and from | |
634 (let ((stop-pos | |
635 (string-match " *at \\| *@ \\| *(\\| *<" from))) | |
636 (setq | |
637 message-of | |
638 (concat (if stop-pos (substring from 0 stop-pos) from) | |
639 "'s message of " date)))) | |
640 (setq subject (or subject (mail-header-subject header))) | |
641 (or (string-match "^[Rr][Ee]:" subject) | |
642 (setq subject (concat "Re: " subject))) | |
643 (setq followup-to (mail-fetch-field "followup-to")) | |
644 (if (or (null respect-poster) ;Ignore followup-to: field. | |
645 (string-equal "" followup-to) ;Bogus header. | |
646 (string-equal "poster" followup-to);Poster | |
647 (and (eq respect-poster 'ask) | |
648 followup-to | |
649 (not (y-or-n-p (concat "Followup to " | |
650 followup-to "? "))))) | |
651 (setq followup-to nil)) | |
652 (setq newsgroups | |
653 (or follow-to followup-to (mail-fetch-field "newsgroups"))) | |
654 (setq references (mail-header-references header)) | |
655 (setq distribution (mail-fetch-field "distribution")) | |
656 ;; Remove bogus distribution. | |
657 (and (stringp distribution) | |
658 (string-match "world" distribution) | |
659 (setq distribution nil)) | |
660 (setq message-id (mail-header-id header)) | |
661 (widen)) | |
662 (setq news-reply-yank-from from) | |
663 (setq news-reply-yank-message-id message-id) | |
664 (news-setup to subject message-of | |
665 (if (stringp newsgroups) newsgroups "") | |
666 article-buffer) | |
667 (if (and newsgroups (listp newsgroups)) | |
668 (progn | |
669 (goto-char (point-min)) | |
670 (while newsgroups | |
671 (insert (car (car newsgroups)) ": " | |
672 (cdr (car newsgroups)) "\n") | |
673 (setq newsgroups (cdr newsgroups))))) | |
674 (nnheader-insert-references references message-id) | |
675 (if distribution | |
676 (progn | |
677 (mail-position-on-field "Distribution") | |
678 (insert distribution))))) | |
679 (current-buffer))))) | |
680 | |
681 ;;; Internal functions. | |
682 | |
683 (defun nntp-send-mode-reader () | |
684 "Send the MODE READER command to the nntp server. | |
685 This function is supposed to be called from `nntp-server-opened-hook'. | |
686 It will make innd servers spawn an nnrpd process to allow actual article | |
687 reading." | |
688 (nntp-send-command "^.*\r?\n" "MODE READER")) | |
689 | |
690 (defun nntp-send-authinfo () | |
691 "Send the AUTHINFO to the nntp server. | |
692 This function is supposed to be called from `nntp-server-opened-hook'. | |
693 It will prompt for a password." | |
694 (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) | |
695 (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" | |
696 (read-string "NNTP password: "))) | |
697 | |
698 (defun nntp-send-authinfo-from-file () | |
699 "Send the AUTHINFO to the nntp server. | |
700 This function is supposed to be called from `nntp-server-opened-hook'. | |
701 It will prompt for a password." | |
702 (and (file-exists-p "~/.nntp-authinfo") | |
703 (save-excursion | |
704 (set-buffer (get-buffer-create " *tull*")) | |
705 (insert-file-contents "~/.nntp-authinfo") | |
706 (goto-char (point-min)) | |
707 (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) | |
708 (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" | |
709 (buffer-substring (point) | |
710 (progn (end-of-line) (point)))) | |
711 (kill-buffer (current-buffer))))) | |
712 | |
713 (defun nntp-default-sentinel (proc status) | |
714 "Default sentinel function for NNTP server process." | |
715 (let ((servers nntp-server-alist) | |
716 server) | |
717 ;; Go through the alist of server names and find the name of the | |
718 ;; server that the process that sent the signal is connected to. | |
719 ;; If you get my drift. | |
720 (if (equal proc nntp-server-process) | |
721 (setq server nntp-address) | |
722 (while (and servers | |
723 (not (equal proc (nth 1 (assq 'nntp-server-process | |
724 (car servers)))))) | |
725 (setq servers (cdr servers))) | |
726 (setq server (car (car servers)))) | |
727 (and server | |
728 (progn | |
729 (message "nntp: Connection closed to server %s" server) | |
730 (ding))))) | |
731 | |
732 (defun nntp-kill-connection (server) | |
733 (let ((proc (nth 1 (assq 'nntp-server-process | |
734 (assoc server nntp-server-alist))))) | |
735 (and proc (delete-process (process-name proc))) | |
736 (nntp-close-server server) | |
737 (setq nntp-timeout-servers (cons server nntp-timeout-servers)) | |
738 (setq nntp-status-string | |
739 (message "Connection timed out to server %s." server)) | |
740 (ding) | |
741 (sit-for 1))) | |
742 | |
743 ;; Encoding and decoding of NNTP text. | |
744 | |
745 (defun nntp-decode-text () | |
746 "Decode text transmitted by NNTP. | |
747 0. Delete status line. | |
748 1. Delete `^M' at end of line. | |
749 2. Delete `.' at end of buffer (end of text mark). | |
750 3. Delete `.' at beginning of line." | |
751 (save-excursion | |
752 (set-buffer nntp-server-buffer) | |
753 ;; Insert newline at end of buffer. | |
754 (goto-char (point-max)) | |
755 (or (bolp) (insert "\n")) | |
756 ;; Delete status line. | |
757 (goto-char (point-min)) | |
758 (delete-region (point) (progn (forward-line 1) (point))) | |
759 ;; Delete `^M' at the end of lines. | |
760 (while (not (eobp)) | |
761 (end-of-line) | |
762 (and (= (preceding-char) ?\r) | |
763 (delete-char -1)) | |
764 (forward-line 1)) | |
765 ;; Delete `.' at end of the buffer (end of text mark). | |
766 (goto-char (point-max)) | |
767 (forward-line -1) | |
768 (if (looking-at "^\\.\n") | |
769 (delete-region (point) (progn (forward-line 1) (point)))) | |
770 ;; Replace `..' at beginning of line with `.'. | |
771 (goto-char (point-min)) | |
772 ;; (replace-regexp "^\\.\\." ".") | |
773 (while (search-forward "\n.." nil t) | |
774 (delete-char -1)))) | |
775 | |
776 (defun nntp-encode-text () | |
777 "Encode text in current buffer for NNTP transmission. | |
778 1. Insert `.' at beginning of line. | |
779 2. Insert `.' at end of buffer (end of text mark)." | |
780 (save-excursion | |
781 ;; Insert newline at end of buffer. | |
782 (goto-char (point-max)) | |
783 (or (bolp) (insert "\n")) | |
784 ;; Replace `.' at beginning of line with `..'. | |
785 (goto-char (point-min)) | |
786 ;; (replace-regexp "^\\." "..") | |
787 (while (search-forward "\n." nil t) | |
788 (insert ".")) | |
789 ;; Insert `.' at end of buffer (end of text mark). | |
790 (goto-char (point-max)) | |
791 (insert ".\r\n"))) | |
792 | |
793 | |
794 ;;; | |
795 ;;; Synchronous Communication with NNTP Server. | |
796 ;;; | |
797 | |
798 (defun nntp-send-command (response cmd &rest args) | |
799 "Wait for server RESPONSE after sending CMD and optional ARGS to server." | |
800 (save-excursion | |
801 ;; Clear communication buffer. | |
802 (set-buffer nntp-server-buffer) | |
803 (erase-buffer) | |
804 (apply 'nntp-send-strings-to-server cmd args) | |
805 (if response | |
806 (nntp-wait-for-response response) | |
807 t))) | |
808 | |
809 (defun nntp-wait-for-response (regexp &optional slow) | |
810 "Wait for server response which matches REGEXP." | |
811 (save-excursion | |
812 (let ((status t) | |
813 (wait t) | |
814 (dotnum 0) ;Number of "." being displayed. | |
815 (dotsize ;How often "." displayed. | |
816 (if (numberp nntp-debug-read) nntp-debug-read 10000))) | |
817 (set-buffer nntp-server-buffer) | |
818 ;; Wait for status response (RFC977). | |
819 ;; 1xx - Informative message. | |
820 ;; 2xx - Command ok. | |
821 ;; 3xx - Command ok so far, send the rest of it. | |
822 ;; 4xx - Command was correct, but couldn't be performed for some | |
823 ;; reason. | |
824 ;; 5xx - Command unimplemented, or incorrect, or a serious | |
825 ;; program error occurred. | |
826 (nntp-accept-response) | |
827 (while wait | |
828 (goto-char (point-min)) | |
829 (if slow | |
830 (progn | |
831 (cond ((re-search-forward "^[23][0-9][0-9]" nil t) | |
832 (setq wait nil)) | |
833 ((re-search-forward "^[45][0-9][0-9]" nil t) | |
834 (setq status nil) | |
835 (setq wait nil)) | |
836 (t (nntp-accept-response))) | |
837 (if (not wait) (delete-region (point-min) | |
838 (progn (beginning-of-line) | |
839 (point))))) | |
840 (cond ((looking-at "[23]") | |
841 (setq wait nil)) | |
842 ((looking-at "[45]") | |
843 (setq status nil) | |
844 (setq wait nil)) | |
845 (t (nntp-accept-response))))) | |
846 ;; Save status message. | |
847 (end-of-line) | |
848 (setq nntp-status-string | |
849 (buffer-substring (point-min) (point))) | |
850 (if status | |
851 (progn | |
852 (setq wait t) | |
853 (while wait | |
854 (goto-char (point-max)) | |
855 (forward-line -1) ;(beginning-of-line) | |
856 ;;(message (buffer-substring | |
857 ;; (point) | |
858 ;; (save-excursion (end-of-line) (point)))) | |
859 (if (looking-at regexp) | |
860 (setq wait nil) | |
861 (if nntp-debug-read | |
862 (let ((newnum (/ (buffer-size) dotsize))) | |
863 (if (not (= dotnum newnum)) | |
864 (progn | |
865 (setq dotnum newnum) | |
866 (message "NNTP: Reading %s" | |
867 (make-string dotnum ?.)))))) | |
868 (nntp-accept-response))) | |
869 ;; Remove "...". | |
870 (if (and nntp-debug-read (> dotnum 0)) | |
871 (message "")) | |
872 ;; Successfully received server response. | |
873 t))))) | |
874 | |
875 | |
876 | |
877 ;;; | |
878 ;;; Low-Level Interface to NNTP Server. | |
879 ;;; | |
880 | |
881 (defun nntp-retrieve-headers-with-xover (sequence) | |
882 (erase-buffer) | |
883 (cond | |
884 | |
885 ;; This server does not talk NOV. | |
886 ((not nntp-server-xover) | |
887 nil) | |
888 | |
889 ;; We don't care about gaps. | |
890 ((not nntp-nov-gap) | |
891 (nntp-send-xover-command | |
892 (car sequence) (nntp-last-element sequence) 'wait) | |
893 | |
894 (goto-char (point-min)) | |
895 (if (looking-at "[1-5][0-9][0-9] ") | |
896 (delete-region (point) (progn (forward-line 1) (point)))) | |
897 (while (search-forward "\r" nil t) | |
898 (replace-match "" t t)) | |
899 (goto-char (point-max)) | |
900 (forward-line -1) | |
901 (if (looking-at "\\.") | |
902 (delete-region (point) (progn (forward-line 1) (point))))) | |
903 | |
904 ;; We do it the hard way. For each gap, an XOVER command is sent | |
905 ;; to the server. We do not wait for a reply from the server, we | |
906 ;; just send them off as fast as we can. That means that we have | |
907 ;; to count the number of responses we get back to find out when we | |
908 ;; have gotten all we asked for. | |
909 ((numberp nntp-nov-gap) | |
910 (let ((count 0) | |
911 (received 0) | |
912 (last-point (point-min)) | |
913 (buf (current-buffer)) | |
914 first) | |
915 ;; We have to check `nntp-server-xover'. If it gets set to nil, | |
916 ;; that means that the server does not understand XOVER, but we | |
917 ;; won't know that until we try. | |
918 (while (and nntp-server-xover sequence) | |
919 (setq first (car sequence)) | |
920 ;; Search forward until we find a gap, or until we run out of | |
921 ;; articles. | |
922 (while (and (cdr sequence) | |
923 (< (- (nth 1 sequence) (car sequence)) nntp-nov-gap)) | |
924 (setq sequence (cdr sequence))) | |
925 | |
926 (if (not (nntp-send-xover-command first (car sequence))) | |
927 () | |
928 (setq sequence (cdr sequence) | |
929 count (1+ count)) | |
930 | |
931 ;; Every 400 requests we have to read the stream in | |
932 ;; order to avoid deadlocks. | |
933 (if (or (null sequence) ;All requests have been sent. | |
934 (zerop (% count nntp-maximum-request))) | |
935 (progn | |
936 (accept-process-output) | |
937 ;; On some Emacs versions the preceding function has | |
938 ;; a tendency to change the buffer. Perhaps. It's | |
14040 | 939 ;; quite difficult to reproduce, because it only |
13401 | 940 ;; seems to happen once in a blue moon. |
941 (set-buffer buf) | |
942 (while (progn | |
943 (goto-char last-point) | |
944 ;; Count replies. | |
945 (while (re-search-forward "^[0-9][0-9][0-9] " nil t) | |
946 (setq received (1+ received))) | |
947 (setq last-point (point)) | |
948 (< received count)) | |
949 (accept-process-output) | |
950 (set-buffer buf)))))) | |
951 | |
952 (if (not nntp-server-xover) | |
953 () | |
954 ;; Wait for the reply from the final command. | |
955 (goto-char (point-max)) | |
956 (re-search-backward "^[0-9][0-9][0-9] " nil t) | |
957 (if (looking-at "^[23]") | |
958 (while (progn | |
959 (goto-char (point-max)) | |
960 (forward-line -1) | |
961 (not (looking-at "^\\.\r?\n"))) | |
962 (nntp-accept-response))) | |
963 | |
964 ;; We remove any "." lines and status lines. | |
965 (goto-char (point-min)) | |
966 (while (search-forward "\r" nil t) | |
967 (delete-char -1)) | |
968 (goto-char (point-min)) | |
969 (delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] "))))) | |
970 | |
971 nntp-server-xover) | |
972 | |
973 (defun nntp-send-xover-command (beg end &optional wait-for-reply) | |
974 (let ((range (format "%d-%d" beg end))) | |
975 (if (stringp nntp-server-xover) | |
976 ;; If `nntp-server-xover' is a string, then we just send this | |
977 ;; command. | |
978 (if wait-for-reply | |
979 (nntp-send-command "^\\.\r?\n" nntp-server-xover range) | |
980 ;; We do not wait for the reply. | |
981 (progn | |
982 (nntp-send-strings-to-server nntp-server-xover range) | |
983 t)) | |
984 (let ((commands nntp-xover-commands)) | |
985 ;; `nntp-xover-commands' is a list of possible XOVER commands. | |
986 ;; We try them all until we get at positive response. | |
987 (while (and commands (eq nntp-server-xover 'try)) | |
988 (nntp-send-command "^\\.\r?\n" (car commands) range) | |
989 (save-excursion | |
990 (set-buffer nntp-server-buffer) | |
991 (goto-char (point-min)) | |
992 (and (looking-at "[23]") ; No error message. | |
993 ;; We also have to look at the lines. Some buggy | |
994 ;; servers give back simple lines with just the | |
995 ;; article number. How... helpful. | |
996 (progn | |
997 (forward-line 1) | |
998 (looking-at "[0-9]+\t...")) ; More text after number. | |
999 (setq nntp-server-xover (car commands)))) | |
1000 (setq commands (cdr commands))) | |
1001 ;; If none of the commands worked, we disable XOVER. | |
1002 (if (eq nntp-server-xover 'try) | |
1003 (save-excursion | |
1004 (set-buffer nntp-server-buffer) | |
1005 (erase-buffer) | |
1006 (setq nntp-server-xover nil))) | |
1007 nntp-server-xover)))) | |
1008 | |
1009 (defun nntp-send-strings-to-server (&rest strings) | |
1010 "Send list of STRINGS to news server as command and its arguments." | |
1011 (let ((cmd (concat (mapconcat 'identity strings " ") "\r\n"))) | |
1012 ;; We open the nntp server if it is down. | |
1013 (or (nntp-server-opened nntp-current-server) | |
1014 (nntp-open-server nntp-current-server) | |
1015 (error (nntp-status-message))) | |
1016 ;; Send the strings. | |
1017 (process-send-string nntp-server-process cmd))) | |
1018 | |
1019 (defun nntp-send-region-to-server (begin end) | |
1020 "Send current buffer region (from BEGIN to END) to news server." | |
1021 (save-excursion | |
1022 ;; We have to work in the buffer associated with NNTP server | |
1023 ;; process because of NEmacs hack. | |
1024 (copy-to-buffer nntp-server-buffer begin end) | |
1025 (set-buffer nntp-server-buffer) | |
1026 (setq begin (point-min)) | |
1027 (setq end (point-max)) | |
1028 ;; `process-send-region' does not work if text to be sent is very | |
1029 ;; large. I don't know maximum size of text sent correctly. | |
1030 (let ((last nil) | |
1031 (size 100)) ;Size of text sent at once. | |
1032 (save-restriction | |
1033 (narrow-to-region begin end) | |
1034 (goto-char begin) | |
1035 (while (not (eobp)) | |
1036 ;;(setq last (min end (+ (point) size))) | |
1037 ;; NEmacs gets confused if character at `last' is Kanji. | |
1038 (setq last (save-excursion | |
1039 (goto-char (min end (+ (point) size))) | |
1040 (or (eobp) (forward-char 1)) ;Adjust point | |
1041 (point))) | |
1042 (process-send-region nntp-server-process (point) last) | |
1043 ;; I don't know whether the next codes solve the known | |
1044 ;; problem of communication error of GNU Emacs. | |
1045 (accept-process-output) | |
1046 ;;(sit-for 0) | |
1047 (goto-char last)))) | |
1048 ;; We cannot erase buffer, because reply may be received. | |
1049 (delete-region begin end))) | |
1050 | |
1051 (defun nntp-open-server-semi-internal (server &optional service) | |
1052 "Open SERVER. | |
1053 If SERVER is nil, use value of environment variable `NNTPSERVER'. | |
1054 If SERVICE, this this as the port number." | |
1055 (let ((server (or server (getenv "NNTPSERVER"))) | |
1056 (status nil) | |
1057 (timer | |
1058 (and nntp-connection-timeout | |
1059 (cond | |
1060 ((fboundp 'run-at-time) | |
1061 (run-at-time nntp-connection-timeout | |
1062 nil 'nntp-kill-connection server)) | |
1063 ((fboundp 'start-itimer) | |
1064 ;; Not sure if this will work or not, only one way to | |
1065 ;; find out | |
1066 (eval '(start-itimer "nntp-timeout" | |
1067 (lambda () | |
1068 (nntp-kill-connection server)) | |
1069 nntp-connection-timeout nil))))))) | |
1070 (save-excursion | |
1071 (set-buffer nntp-server-buffer) | |
1072 (setq nntp-status-string "") | |
1073 (message "nntp: Connecting to server on %s..." server) | |
1074 (cond ((and server (nntp-open-server-internal server service)) | |
1075 (setq nntp-address server) | |
1076 (setq status | |
1077 (condition-case nil | |
1078 (nntp-wait-for-response "^[23].*\r?\n" 'slow) | |
1079 (error nil) | |
1080 (quit nil))) | |
1081 (or status (nntp-close-server-internal server)) | |
1082 (and nntp-server-process | |
1083 (progn | |
1084 (set-process-sentinel | |
1085 nntp-server-process 'nntp-default-sentinel) | |
1086 ;; You can send commands at startup like AUTHINFO here. | |
1087 ;; Added by Hallvard B Furuseth <h.b.furuseth@usit.uio.no> | |
1088 (run-hooks 'nntp-server-opened-hook)))) | |
1089 ((null server) | |
1090 (setq nntp-status-string "NNTP server is not specified.")) | |
1091 (t ; We couldn't open the server. | |
1092 (setq nntp-status-string | |
1093 (buffer-substring (point-min) (point-max))) | |
1094 (setq nntp-timeout-servers (cons server nntp-timeout-servers)))) | |
1095 (and timer (cancel-timer timer)) | |
1096 (message "") | |
1097 (or status | |
1098 (setq nntp-current-server nil | |
1099 nntp-async-number nil)) | |
1100 status))) | |
1101 | |
1102 (defun nntp-open-server-internal (server &optional service) | |
1103 "Open connection to news server on SERVER by SERVICE (default is nntp)." | |
1104 (let (proc) | |
1105 (save-excursion | |
1106 ;; Use TCP/IP stream emulation package if needed. | |
1107 (or (fboundp 'open-network-stream) | |
1108 (require 'tcp)) | |
1109 ;; Initialize communication buffer. | |
1110 (nnheader-init-server-buffer) | |
1111 (set-buffer nntp-server-buffer) | |
1112 (if (setq proc | |
1113 (condition-case nil | |
1114 (funcall nntp-open-server-function server) | |
1115 (error nil))) | |
1116 (progn | |
1117 (setq nntp-server-process proc) | |
1118 ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>. | |
1119 (process-kill-without-query proc) | |
1120 (setq nntp-address server) | |
1121 ;; It is possible to change kanji-fileio-code in this hook. | |
1122 (run-hooks 'nntp-server-hook) | |
1123 (push proc nntp-opened-connections) | |
1124 nntp-server-process))))) | |
1125 | |
1126 (defun nntp-open-network-stream (server) | |
1127 (open-network-stream | |
1128 "nntpd" nntp-server-buffer server nntp-port-number)) | |
1129 | |
1130 (defun nntp-open-rlogin (server) | |
1131 (let ((proc (start-process "nntpd" nntp-server-buffer "rsh" server))) | |
1132 (process-send-string proc (mapconcat 'identity nntp-rlogin-parameters | |
1133 " ")) | |
1134 (process-send-string proc "\n"))) | |
1135 | |
1136 (defun nntp-telnet-to-machine () | |
1137 (let (b) | |
1138 (telnet "localhost") | |
1139 (goto-char (point-min)) | |
1140 (while (not (re-search-forward "^login: *" nil t)) | |
1141 (sit-for 1) | |
1142 (goto-char (point-min))) | |
1143 (goto-char (point-max)) | |
1144 (insert "larsi") | |
1145 (telnet-send-input) | |
1146 (setq b (point)) | |
1147 (while (not (re-search-forward ">" nil t)) | |
1148 (sit-for 1) | |
1149 (goto-char b)) | |
1150 (goto-char (point-max)) | |
1151 (insert "ls") | |
1152 (telnet-send-input))) | |
1153 | |
1154 (defun nntp-close-server-internal (&optional server) | |
1155 "Close connection to news server." | |
1156 (nntp-possibly-change-server nil server) | |
1157 (if nntp-server-process | |
1158 (delete-process nntp-server-process)) | |
1159 (setq nntp-server-process nil) | |
1160 (setq nntp-address "")) | |
1161 | |
1162 (defun nntp-accept-response () | |
1163 "Read response of server. | |
1164 It is well-known that the communication speed will be much improved by | |
1165 defining this function as macro." | |
1166 ;; To deal with server process exiting before | |
1167 ;; accept-process-output is called. | |
1168 ;; Suggested by Jason Venner <jason@violet.berkeley.edu>. | |
1169 ;; This is a copy of `nntp-default-sentinel'. | |
1170 (let ((buf (current-buffer))) | |
1171 (prog1 | |
1172 (if (or (not nntp-server-process) | |
1173 (not (memq (process-status nntp-server-process) '(open run)))) | |
1174 (error "nntp: Process connection closed; %s" (nntp-status-message)) | |
1175 (if nntp-buggy-select | |
1176 (progn | |
1177 ;; We cannot use `accept-process-output'. | |
1178 ;; Fujitsu UTS requires messages during sleep-for. | |
1179 ;; I don't know why. | |
1180 (message "NNTP: Reading...") | |
1181 (sleep-for 1) | |
1182 (message "")) | |
1183 (condition-case errorcode | |
1184 (accept-process-output nntp-server-process) | |
1185 (error | |
1186 (cond ((string-equal "select error: Invalid argument" | |
1187 (nth 1 errorcode)) | |
1188 ;; Ignore select error. | |
1189 nil) | |
1190 (t | |
1191 (signal (car errorcode) (cdr errorcode)))))))) | |
1192 (set-buffer buf)))) | |
1193 | |
1194 (defun nntp-last-element (list) | |
1195 "Return last element of LIST." | |
1196 (while (cdr list) | |
1197 (setq list (cdr list))) | |
1198 (car list)) | |
1199 | |
13588
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
1200 (defun nntp-possibly-change-server (newsgroup server &optional connectionless) |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
1201 "Check whether the virtual server needs changing." |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
1202 (if (and server |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
1203 (not (nntp-server-opened server))) |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
1204 ;; This virtual server isn't open, so we (re)open it here. |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
1205 (nntp-open-server server nil t)) |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
1206 (if (and newsgroup |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
1207 (not (equal newsgroup nntp-current-group))) |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
1208 ;; Set the proper current group. |
c50d9d86eda9
(nntp-open-server): Accept a second optional parameter
Richard M. Stallman <rms@gnu.org>
parents:
13401
diff
changeset
|
1209 (nntp-request-group newsgroup server))) |
13401 | 1210 |
1211 (defun nntp-try-list-active (group) | |
1212 (nntp-list-active-group group) | |
1213 (save-excursion | |
1214 (set-buffer nntp-server-buffer) | |
1215 (goto-char (point-min)) | |
1216 (cond ((looking-at "5[0-9]+") | |
1217 (setq nntp-server-list-active-group nil)) | |
1218 (t | |
1219 (setq nntp-server-list-active-group t))))) | |
1220 | |
1221 (defun nntp-async-server-opened () | |
1222 (and nntp-async-process | |
1223 (memq (process-status nntp-async-process) '(open run)))) | |
1224 | |
1225 (defun nntp-async-open-server () | |
1226 (save-excursion | |
1227 (set-buffer (generate-new-buffer " *async-nntp*")) | |
1228 (setq nntp-async-buffer (current-buffer)) | |
1229 (buffer-disable-undo (current-buffer))) | |
1230 (let ((nntp-server-process nil) | |
1231 (nntp-server-buffer nntp-async-buffer)) | |
1232 (nntp-open-server-semi-internal nntp-address nntp-port-number) | |
1233 (if (not (setq nntp-async-process nntp-server-process)) | |
1234 (progn | |
1235 (setq nntp-async-number nil)) | |
1236 (set-process-buffer nntp-async-process nntp-async-buffer)))) | |
1237 | |
1238 (defun nntp-async-fetch-articles (article) | |
1239 (if (stringp article) | |
1240 () | |
1241 (let ((articles (cdr (memq (assq article nntp-async-articles) | |
1242 nntp-async-articles))) | |
1243 (max (cond ((numberp nntp-async-number) | |
1244 nntp-async-number) | |
1245 ((eq nntp-async-number t) | |
1246 (length nntp-async-articles)) | |
1247 (t 0))) | |
1248 nart) | |
1249 (while (and (>= (setq max (1- max)) 0) | |
1250 articles) | |
1251 (or (memq (setq nart (car (car articles))) nntp-async-fetched) | |
1252 (progn | |
1253 (nntp-async-send-strings "ARTICLE " (int-to-string nart)) | |
1254 (setq nntp-async-fetched (cons nart nntp-async-fetched)))) | |
1255 (setq articles (cdr articles)))))) | |
1256 | |
1257 (defun nntp-async-send-strings (&rest strings) | |
1258 (let ((cmd (concat (mapconcat 'identity strings " ") "\r\n"))) | |
1259 (or (nntp-async-server-opened) | |
1260 (nntp-async-open-server) | |
1261 (error (nntp-status-message))) | |
1262 (process-send-string nntp-async-process cmd))) | |
1263 | |
1264 (defun nntp-async-request-group (group) | |
1265 (if (equal group nntp-current-group) | |
1266 () | |
1267 (let ((asyncs (assoc group nntp-async-group-alist))) | |
1268 ;; A new group has been selected, so we push the current state | |
1269 ;; of async articles on an alist, and pull the old state off. | |
1270 (setq nntp-async-group-alist | |
1271 (cons (list nntp-current-group | |
1272 nntp-async-articles nntp-async-fetched | |
1273 nntp-async-process) | |
1274 (delq asyncs nntp-async-group-alist))) | |
1275 (and asyncs | |
1276 (progn | |
1277 (setq nntp-async-articles (nth 1 asyncs)) | |
1278 (setq nntp-async-fetched (nth 2 asyncs)) | |
1279 (setq nntp-async-process (nth 3 asyncs))))))) | |
1280 | |
1281 (provide 'nntp) | |
1282 | |
1283 ;;; nntp.el ends here |