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