Mercurial > emacs
annotate lisp/=nnspool.el @ 1398:70d0cd4c5bff
mem_limits.h is now called mem-limits.h.
author | Roland McGrath <roland@gnu.org> |
---|---|
date | Mon, 12 Oct 1992 18:55:05 +0000 |
parents | bff32d8ecc5e |
children | cd90d49526ae |
rev | line source |
---|---|
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
1 ;;; nnspool.el --- spool access using NNTP for GNU Emacs |
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
2 |
882 | 3 ;; Copyright (C) 1988, 1989, 1990 Free Software Foundation, Inc. |
846
20674ae6bf52
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
814
diff
changeset
|
4 |
790
47ec7c4c42bc
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
5 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
814
38b2499cb3e9
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
790
diff
changeset
|
6 ;; Keywords: news |
790
47ec7c4c42bc
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
7 |
87 | 8 ;; This file is part of GNU Emacs. |
9 | |
882 | 10 ;; GNU Emacs is free software; you can redistribute it and/or modify |
11 ;; it under the terms of the GNU General Public License as published by | |
12 ;; the Free Software Foundation; either version 2, or (at your option) | |
13 ;; any later version. | |
87 | 14 |
882 | 15 ;; GNU Emacs is distributed in the hope that it will be useful, |
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
87 | 23 |
790
47ec7c4c42bc
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
24 ;;; Code: |
47ec7c4c42bc
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
25 |
87 | 26 (require 'nntp) |
27 | |
28 (defvar nnspool-inews-program news-inews-program | |
29 "*Program to post news.") | |
30 | |
31 (defvar nnspool-inews-switches '("-h") | |
32 "*Switches for nnspool-request-post to pass to `inews' for posting news.") | |
33 | |
34 (defvar nnspool-spool-directory news-path | |
35 "*Local news spool directory.") | |
36 | |
37 (defvar nnspool-active-file "/usr/lib/news/active" | |
38 "*Local news active file.") | |
39 | |
40 (defvar nnspool-history-file "/usr/lib/news/history" | |
41 "*Local news history file.") | |
42 | |
43 | |
44 | |
45 (defconst nnspool-version "NNSPOOL 1.10" | |
46 "Version numbers of this version of NNSPOOL.") | |
47 | |
48 (defvar nnspool-current-directory nil | |
49 "Current news group directory.") | |
50 | |
51 ;;; | |
52 ;;; Replacement of Extended Command for retrieving many headers. | |
53 ;;; | |
54 | |
55 (defun nnspool-retrieve-headers (sequence) | |
56 "Return list of article headers specified by SEQUENCE of article id. | |
57 The format of list is | |
58 `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'. | |
59 Reader macros for the vector are defined as `nntp-header-FIELD'. | |
60 Writer macros for the vector are defined as `nntp-set-header-FIELD'. | |
61 News group must be selected before calling me." | |
62 (save-excursion | |
63 (set-buffer nntp-server-buffer) | |
64 ;;(erase-buffer) | |
65 (let ((file nil) | |
66 (number (length sequence)) | |
67 (count 0) | |
68 (headers nil) ;Result list. | |
69 (article 0) | |
70 (subject nil) | |
71 (message-id nil) | |
72 (from nil) | |
73 (xref nil) | |
74 (lines 0) | |
75 (date nil) | |
76 (references nil)) | |
77 (while sequence | |
78 ;;(nntp-send-strings-to-server "HEAD" (car sequence)) | |
79 (setq article (car sequence)) | |
80 (setq file | |
81 (concat nnspool-current-directory (prin1-to-string article))) | |
82 (if (and (file-exists-p file) | |
83 (not (file-directory-p file))) | |
84 (progn | |
85 (erase-buffer) | |
86 (insert-file-contents file) | |
87 ;; Make message body invisible. | |
88 (goto-char (point-min)) | |
89 (search-forward "\n\n" nil 'move) | |
90 (narrow-to-region (point-min) (point)) | |
91 ;; Fold continuation lines. | |
92 (goto-char (point-min)) | |
93 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) | |
94 (replace-match " " t t)) | |
95 ;; Make it possible to search for `\nFIELD'. | |
96 (goto-char (point-min)) | |
97 (insert "\n") | |
98 ;; Extract From: | |
99 (goto-char (point-min)) | |
100 (if (search-forward "\nFrom: " nil t) | |
101 (setq from (buffer-substring | |
102 (point) | |
103 (save-excursion (end-of-line) (point)))) | |
104 (setq from "(Unknown User)")) | |
105 ;; Extract Subject: | |
106 (goto-char (point-min)) | |
107 (if (search-forward "\nSubject: " nil t) | |
108 (setq subject (buffer-substring | |
109 (point) | |
110 (save-excursion (end-of-line) (point)))) | |
111 (setq subject "(None)")) | |
112 ;; Extract Message-ID: | |
113 (goto-char (point-min)) | |
114 (if (search-forward "\nMessage-ID: " nil t) | |
115 (setq message-id (buffer-substring | |
116 (point) | |
117 (save-excursion (end-of-line) (point)))) | |
118 (setq message-id nil)) | |
119 ;; Extract Date: | |
120 (goto-char (point-min)) | |
121 (if (search-forward "\nDate: " nil t) | |
122 (setq date (buffer-substring | |
123 (point) | |
124 (save-excursion (end-of-line) (point)))) | |
125 (setq date nil)) | |
126 ;; Extract Lines: | |
127 (goto-char (point-min)) | |
128 (if (search-forward "\nLines: " nil t) | |
129 (setq lines (string-to-int | |
130 (buffer-substring | |
131 (point) | |
132 (save-excursion (end-of-line) (point))))) | |
133 (setq lines 0)) | |
134 ;; Extract Xref: | |
135 (goto-char (point-min)) | |
136 (if (search-forward "\nXref: " nil t) | |
137 (setq xref (buffer-substring | |
138 (point) | |
139 (save-excursion (end-of-line) (point)))) | |
140 (setq xref nil)) | |
141 ;; Extract References: | |
142 (goto-char (point-min)) | |
143 (if (search-forward "\nReferences: " nil t) | |
144 (setq references (buffer-substring | |
145 (point) | |
146 (save-excursion (end-of-line) (point)))) | |
147 (setq references nil)) | |
148 (setq headers | |
149 (cons (vector article subject from | |
150 xref lines date | |
151 message-id references) headers)) | |
152 )) | |
153 (setq sequence (cdr sequence)) | |
154 (setq count (1+ count)) | |
155 (and (numberp nntp-large-newsgroup) | |
156 (> number nntp-large-newsgroup) | |
157 (zerop (% count 20)) | |
158 (message "NNSPOOL: %d%% of headers received." | |
159 (/ (* count 100) number))) | |
160 ) | |
161 (and (numberp nntp-large-newsgroup) | |
162 (> number nntp-large-newsgroup) | |
163 (message "NNSPOOL: 100%% of headers received.")) | |
164 (nreverse headers) | |
165 ))) | |
166 | |
167 | |
168 ;;; | |
169 ;;; Replacement of NNTP Raw Interface. | |
170 ;;; | |
171 | |
172 (defun nnspool-open-server (host &optional service) | |
173 "Open news server on HOST. | |
174 If HOST is nil, use value of environment variable `NNTPSERVER'. | |
175 If optional argument SERVICE is non-nil, open by the service name." | |
176 (let ((host (or host (getenv "NNTPSERVER"))) | |
177 (status nil)) | |
178 (setq nntp-status-message-string "") | |
179 (cond ((and (file-directory-p nnspool-spool-directory) | |
180 (file-exists-p nnspool-active-file) | |
181 (string-equal host (system-name))) | |
182 (setq status (nnspool-open-server-internal host service))) | |
183 ((string-equal host (system-name)) | |
184 (setq nntp-status-message-string | |
185 (format "%s has no news spool. Goodbye." host))) | |
186 ((null host) | |
187 (setq nntp-status-message-string "NNTP server is not specified.")) | |
188 (t | |
189 (setq nntp-status-message-string | |
190 (format "NNSPOOL: cannot talk to %s." host))) | |
191 ) | |
192 status | |
193 )) | |
194 | |
195 (defun nnspool-close-server () | |
196 "Close news server." | |
197 (nnspool-close-server-internal)) | |
198 | |
199 (fset 'nnspool-request-quit (symbol-function 'nnspool-close-server)) | |
200 | |
201 (defun nnspool-server-opened () | |
202 "Return server process status, T or NIL. | |
203 If the stream is opened, return T, otherwise return NIL." | |
204 (and nntp-server-buffer | |
205 (get-buffer nntp-server-buffer))) | |
206 | |
207 (defun nnspool-status-message () | |
208 "Return server status response as string." | |
209 nntp-status-message-string | |
210 ) | |
211 | |
212 (defun nnspool-request-article (id) | |
213 "Select article by message ID (or number)." | |
214 (let ((file (if (stringp id) | |
215 (nnspool-find-article-by-message-id id) | |
216 (concat nnspool-current-directory (prin1-to-string id))))) | |
217 (if (and (stringp file) | |
218 (file-exists-p file) | |
219 (not (file-directory-p file))) | |
220 (save-excursion | |
221 (nnspool-find-file file))) | |
222 )) | |
223 | |
224 (defun nnspool-request-body (id) | |
225 "Select article body by message ID (or number)." | |
226 (if (nnspool-request-article id) | |
227 (save-excursion | |
228 (set-buffer nntp-server-buffer) | |
229 (goto-char (point-min)) | |
230 (if (search-forward "\n\n" nil t) | |
231 (delete-region (point-min) (point))) | |
232 t | |
233 ) | |
234 )) | |
235 | |
236 (defun nnspool-request-head (id) | |
237 "Select article head by message ID (or number)." | |
238 (if (nnspool-request-article id) | |
239 (save-excursion | |
240 (set-buffer nntp-server-buffer) | |
241 (goto-char (point-min)) | |
242 (if (search-forward "\n\n" nil t) | |
243 (delete-region (1- (point)) (point-max))) | |
244 t | |
245 ) | |
246 )) | |
247 | |
248 (defun nnspool-request-stat (id) | |
249 "Select article by message ID (or number)." | |
250 (error "NNSPOOL: STAT is not implemented.")) | |
251 | |
252 (defun nnspool-request-group (group) | |
253 "Select news GROUP." | |
254 (let ((pathname (nnspool-article-pathname | |
255 (nnspool-replace-chars-in-string group ?. ?/)))) | |
256 (if (file-directory-p pathname) | |
257 (setq nnspool-current-directory pathname)) | |
258 )) | |
259 | |
260 (defun nnspool-request-list () | |
261 "List valid newsgoups." | |
262 (save-excursion | |
263 (nnspool-find-file nnspool-active-file))) | |
264 | |
265 (defun nnspool-request-last () | |
232 | 266 "Set current article pointer to the previous article in the current news group." |
87 | 267 (error "NNSPOOL: LAST is not implemented.")) |
268 | |
269 (defun nnspool-request-next () | |
270 "Advance current article pointer." | |
271 (error "NNSPOOL: NEXT is not implemented.")) | |
272 | |
273 (defun nnspool-request-post () | |
274 "Post a new news in current buffer." | |
275 (save-excursion | |
276 ;; We have to work in the server buffer because of NEmacs hack. | |
277 (copy-to-buffer nntp-server-buffer (point-min) (point-max)) | |
278 (set-buffer nntp-server-buffer) | |
279 (apply 'call-process-region | |
280 (point-min) (point-max) | |
281 nnspool-inews-program 'delete t nil nnspool-inews-switches) | |
282 (prog1 | |
283 (or (zerop (buffer-size)) | |
284 ;; If inews returns strings, it must be error message | |
285 ;; unless SPOOLNEWS is defined. | |
286 ;; This condition is very weak, but there is no good rule | |
287 ;; identifying errors when SPOOLNEWS is defined. | |
288 ;; Suggested by ohm@kaba.junet. | |
289 (string-match "spooled" (buffer-string))) | |
290 ;; Make status message by unfolding lines. | |
291 (subst-char-in-region (point-min) (point-max) ?\n ?\\ 'noundo) | |
292 (setq nntp-status-message-string (buffer-string)) | |
293 (erase-buffer)) | |
294 )) | |
295 | |
296 | |
297 ;;; | |
298 ;;; Replacement of Low-Level Interface to NNTP Server. | |
299 ;;; | |
300 | |
301 (defun nnspool-open-server-internal (host &optional service) | |
302 "Open connection to news server on HOST by SERVICE (default is nntp)." | |
303 (save-excursion | |
304 (if (not (string-equal host (system-name))) | |
305 (error "NNSPOOL: cannot talk to %s." host)) | |
306 ;; Initialize communication buffer. | |
307 (setq nntp-server-buffer (get-buffer-create " *nntpd*")) | |
308 (set-buffer nntp-server-buffer) | |
309 (buffer-flush-undo (current-buffer)) | |
310 (erase-buffer) | |
311 (kill-all-local-variables) | |
312 (setq case-fold-search t) ;Should ignore case. | |
313 (setq nntp-server-process nil) | |
314 (setq nntp-server-name host) | |
315 ;; It is possible to change kanji-fileio-code in this hook. | |
316 (run-hooks 'nntp-server-hook) | |
317 t | |
318 )) | |
319 | |
320 (defun nnspool-close-server-internal () | |
321 "Close connection to news server." | |
322 (if (get-file-buffer nnspool-history-file) | |
323 (kill-buffer (get-file-buffer nnspool-history-file))) | |
324 (if nntp-server-buffer | |
325 (kill-buffer nntp-server-buffer)) | |
326 (setq nntp-server-buffer nil) | |
327 (setq nntp-server-process nil)) | |
328 | |
329 (defun nnspool-find-article-by-message-id (id) | |
232 | 330 "Return full pathname of an article identified by message-ID." |
87 | 331 (save-excursion |
332 (let ((buffer (get-file-buffer nnspool-history-file))) | |
333 (if buffer | |
334 (set-buffer buffer) | |
335 ;; Finding history file may take lots of time. | |
336 (message "Reading history file...") | |
337 (set-buffer (find-file-noselect nnspool-history-file)) | |
338 (message "Reading history file... done"))) | |
339 ;; Search from end of the file. I think this is much faster than | |
340 ;; do from the beginning of the file. | |
341 (goto-char (point-max)) | |
342 (if (re-search-backward | |
343 (concat "^" (regexp-quote id) | |
344 "[ \t].*[ \t]\\([^ \t/]+\\)/\\([0-9]+\\)[ \t]*$") nil t) | |
345 (let ((group (buffer-substring (match-beginning 1) (match-end 1))) | |
346 (number (buffer-substring (match-beginning 2) (match-end 2)))) | |
347 (concat (nnspool-article-pathname | |
348 (nnspool-replace-chars-in-string group ?. ?/)) | |
349 number)) | |
350 ))) | |
351 | |
352 (defun nnspool-find-file (file) | |
353 "Insert FILE in server buffer safely." | |
354 (set-buffer nntp-server-buffer) | |
355 (erase-buffer) | |
356 (condition-case () | |
357 (progn (insert-file-contents file) t) | |
358 (file-error nil) | |
359 )) | |
360 | |
361 (defun nnspool-article-pathname (group) | |
362 "Make pathname for GROUP." | |
363 (concat (file-name-as-directory nnspool-spool-directory) group "/")) | |
364 | |
365 (defun nnspool-replace-chars-in-string (string from to) | |
366 "Replace characters in STRING from FROM to TO." | |
367 (let ((string (substring string 0)) ;Copy string. | |
368 (len (length string)) | |
369 (idx 0)) | |
370 ;; Replace all occurence of FROM with TO. | |
371 (while (< idx len) | |
372 (if (= (aref string idx) from) | |
373 (aset string idx to)) | |
374 (setq idx (1+ idx))) | |
375 string | |
376 )) | |
584 | 377 |
378 (provide 'nnspool) | |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
379 |
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
380 ;;; nnspool.el ends here |