Mercurial > emacs
annotate lisp/=nnspool.el @ 32545:288723d38c06
(Fframe_parameters): If a tty's frame's param_alist says
the colors are unspecified and reversed, reverse fore- and back-
ground in the returned value.
(Fframe_parameter): Ditto.
author | Eli Zaretskii <eliz@gnu.org> |
---|---|
date | Mon, 16 Oct 2000 19:15:09 +0000 |
parents | 507f64624555 |
children |
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 |
2843 | 3 ;; Copyright (C) 1988, 1989, 1990, 1993 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 | |
2843 | 40 (defvar nnspool-newsgroups-file "/usr/lib/news/newsgroups" |
41 "*Local news newsgroups file.") | |
42 | |
43 (defvar nnspool-distributions-file "/usr/lib/news/distributions" | |
44 "*Local news distributions file.") | |
45 | |
87 | 46 (defvar nnspool-history-file "/usr/lib/news/history" |
47 "*Local news history file.") | |
48 | |
49 | |
50 | |
2843 | 51 (defconst nnspool-version "NNSPOOL 1.12" |
87 | 52 "Version numbers of this version of NNSPOOL.") |
53 | |
54 (defvar nnspool-current-directory nil | |
55 "Current news group directory.") | |
56 | |
57 ;;; | |
58 ;;; Replacement of Extended Command for retrieving many headers. | |
59 ;;; | |
60 | |
61 (defun nnspool-retrieve-headers (sequence) | |
62 "Return list of article headers specified by SEQUENCE of article id. | |
63 The format of list is | |
64 `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'. | |
2843 | 65 If there is no References: field, In-Reply-To: field is used instead. |
87 | 66 Reader macros for the vector are defined as `nntp-header-FIELD'. |
67 Writer macros for the vector are defined as `nntp-set-header-FIELD'. | |
2843 | 68 Newsgroup must be selected before calling this." |
87 | 69 (save-excursion |
70 (set-buffer nntp-server-buffer) | |
71 ;;(erase-buffer) | |
72 (let ((file nil) | |
73 (number (length sequence)) | |
74 (count 0) | |
75 (headers nil) ;Result list. | |
76 (article 0) | |
77 (subject nil) | |
78 (message-id nil) | |
79 (from nil) | |
80 (xref nil) | |
81 (lines 0) | |
82 (date nil) | |
83 (references nil)) | |
84 (while sequence | |
85 ;;(nntp-send-strings-to-server "HEAD" (car sequence)) | |
86 (setq article (car sequence)) | |
87 (setq file | |
88 (concat nnspool-current-directory (prin1-to-string article))) | |
89 (if (and (file-exists-p file) | |
90 (not (file-directory-p file))) | |
91 (progn | |
92 (erase-buffer) | |
93 (insert-file-contents file) | |
94 ;; Make message body invisible. | |
95 (goto-char (point-min)) | |
96 (search-forward "\n\n" nil 'move) | |
97 (narrow-to-region (point-min) (point)) | |
98 ;; Fold continuation lines. | |
99 (goto-char (point-min)) | |
100 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) | |
101 (replace-match " " t t)) | |
102 ;; Make it possible to search for `\nFIELD'. | |
103 (goto-char (point-min)) | |
104 (insert "\n") | |
105 ;; Extract From: | |
106 (goto-char (point-min)) | |
107 (if (search-forward "\nFrom: " nil t) | |
108 (setq from (buffer-substring | |
109 (point) | |
110 (save-excursion (end-of-line) (point)))) | |
111 (setq from "(Unknown User)")) | |
112 ;; Extract Subject: | |
113 (goto-char (point-min)) | |
114 (if (search-forward "\nSubject: " nil t) | |
115 (setq subject (buffer-substring | |
116 (point) | |
117 (save-excursion (end-of-line) (point)))) | |
118 (setq subject "(None)")) | |
119 ;; Extract Message-ID: | |
120 (goto-char (point-min)) | |
121 (if (search-forward "\nMessage-ID: " nil t) | |
122 (setq message-id (buffer-substring | |
123 (point) | |
124 (save-excursion (end-of-line) (point)))) | |
125 (setq message-id nil)) | |
126 ;; Extract Date: | |
127 (goto-char (point-min)) | |
128 (if (search-forward "\nDate: " nil t) | |
129 (setq date (buffer-substring | |
130 (point) | |
131 (save-excursion (end-of-line) (point)))) | |
132 (setq date nil)) | |
133 ;; Extract Lines: | |
134 (goto-char (point-min)) | |
135 (if (search-forward "\nLines: " nil t) | |
136 (setq lines (string-to-int | |
137 (buffer-substring | |
138 (point) | |
139 (save-excursion (end-of-line) (point))))) | |
140 (setq lines 0)) | |
141 ;; Extract Xref: | |
142 (goto-char (point-min)) | |
143 (if (search-forward "\nXref: " nil t) | |
144 (setq xref (buffer-substring | |
145 (point) | |
146 (save-excursion (end-of-line) (point)))) | |
147 (setq xref nil)) | |
148 ;; Extract References: | |
2843 | 149 ;; If no References: field, use In-Reply-To: field instead. |
87 | 150 (goto-char (point-min)) |
2843 | 151 (if (or (search-forward "\nReferences: " nil t) |
152 (search-forward "\nIn-Reply-To: " nil t)) | |
87 | 153 (setq references (buffer-substring |
154 (point) | |
155 (save-excursion (end-of-line) (point)))) | |
156 (setq references nil)) | |
2843 | 157 ;; Collect valid article only. |
158 (and article | |
159 message-id | |
160 (setq headers | |
161 (cons (vector article subject from | |
162 xref lines date | |
163 message-id references) headers))) | |
87 | 164 )) |
165 (setq sequence (cdr sequence)) | |
166 (setq count (1+ count)) | |
167 (and (numberp nntp-large-newsgroup) | |
168 (> number nntp-large-newsgroup) | |
169 (zerop (% count 20)) | |
2843 | 170 (message "NNSPOOL: Receiving headers... %d%%" |
87 | 171 (/ (* count 100) number))) |
172 ) | |
173 (and (numberp nntp-large-newsgroup) | |
174 (> number nntp-large-newsgroup) | |
2843 | 175 (message "NNSPOOL: Receiving headers... done")) |
87 | 176 (nreverse headers) |
177 ))) | |
178 | |
179 | |
180 ;;; | |
181 ;;; Replacement of NNTP Raw Interface. | |
182 ;;; | |
183 | |
184 (defun nnspool-open-server (host &optional service) | |
185 "Open news server on HOST. | |
186 If HOST is nil, use value of environment variable `NNTPSERVER'. | |
187 If optional argument SERVICE is non-nil, open by the service name." | |
188 (let ((host (or host (getenv "NNTPSERVER"))) | |
189 (status nil)) | |
2843 | 190 (setq nntp-status-string "") |
87 | 191 (cond ((and (file-directory-p nnspool-spool-directory) |
192 (file-exists-p nnspool-active-file) | |
193 (string-equal host (system-name))) | |
194 (setq status (nnspool-open-server-internal host service))) | |
195 ((string-equal host (system-name)) | |
2843 | 196 (setq nntp-status-string |
87 | 197 (format "%s has no news spool. Goodbye." host))) |
198 ((null host) | |
2843 | 199 (setq nntp-status-string "NNTP server is not specified.")) |
87 | 200 (t |
2843 | 201 (setq nntp-status-string |
87 | 202 (format "NNSPOOL: cannot talk to %s." host))) |
203 ) | |
204 status | |
205 )) | |
206 | |
207 (defun nnspool-close-server () | |
208 "Close news server." | |
209 (nnspool-close-server-internal)) | |
210 | |
211 (fset 'nnspool-request-quit (symbol-function 'nnspool-close-server)) | |
212 | |
213 (defun nnspool-server-opened () | |
214 "Return server process status, T or NIL. | |
215 If the stream is opened, return T, otherwise return NIL." | |
216 (and nntp-server-buffer | |
217 (get-buffer nntp-server-buffer))) | |
218 | |
219 (defun nnspool-status-message () | |
220 "Return server status response as string." | |
2843 | 221 nntp-status-string |
87 | 222 ) |
223 | |
224 (defun nnspool-request-article (id) | |
225 "Select article by message ID (or number)." | |
226 (let ((file (if (stringp id) | |
227 (nnspool-find-article-by-message-id id) | |
228 (concat nnspool-current-directory (prin1-to-string id))))) | |
229 (if (and (stringp file) | |
230 (file-exists-p file) | |
231 (not (file-directory-p file))) | |
232 (save-excursion | |
233 (nnspool-find-file file))) | |
234 )) | |
235 | |
236 (defun nnspool-request-body (id) | |
237 "Select article body 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 (point-min) (point))) | |
244 t | |
245 ) | |
246 )) | |
247 | |
248 (defun nnspool-request-head (id) | |
249 "Select article head by message ID (or number)." | |
250 (if (nnspool-request-article id) | |
251 (save-excursion | |
252 (set-buffer nntp-server-buffer) | |
253 (goto-char (point-min)) | |
254 (if (search-forward "\n\n" nil t) | |
255 (delete-region (1- (point)) (point-max))) | |
256 t | |
257 ) | |
258 )) | |
259 | |
260 (defun nnspool-request-stat (id) | |
261 "Select article by message ID (or number)." | |
2843 | 262 (setq nntp-status-string "NNSPOOL: STAT is not implemented.") |
263 nil | |
264 ) | |
87 | 265 |
266 (defun nnspool-request-group (group) | |
267 "Select news GROUP." | |
268 (let ((pathname (nnspool-article-pathname | |
269 (nnspool-replace-chars-in-string group ?. ?/)))) | |
270 (if (file-directory-p pathname) | |
271 (setq nnspool-current-directory pathname)) | |
272 )) | |
273 | |
274 (defun nnspool-request-list () | |
2843 | 275 "List active newsgoups." |
87 | 276 (save-excursion |
277 (nnspool-find-file nnspool-active-file))) | |
278 | |
2843 | 279 (defun nnspool-request-list-newsgroups () |
280 "List newsgroups (defined in NNTP2)." | |
281 (save-excursion | |
282 (nnspool-find-file nnspool-newsgroups-file))) | |
283 | |
284 (defun nnspool-request-list-distributions () | |
285 "List distributions (defined in NNTP2)." | |
286 (save-excursion | |
287 (nnspool-find-file nnspool-distributions-file))) | |
288 | |
87 | 289 (defun nnspool-request-last () |
2843 | 290 "Set current article pointer to the previous article |
291 in the current news group." | |
292 (setq nntp-status-string "NNSPOOL: LAST is not implemented.") | |
293 nil | |
294 ) | |
87 | 295 |
296 (defun nnspool-request-next () | |
297 "Advance current article pointer." | |
2843 | 298 (setq nntp-status-string "NNSPOOL: NEXT is not implemented.") |
299 nil | |
300 ) | |
87 | 301 |
302 (defun nnspool-request-post () | |
303 "Post a new news in current buffer." | |
304 (save-excursion | |
305 ;; We have to work in the server buffer because of NEmacs hack. | |
306 (copy-to-buffer nntp-server-buffer (point-min) (point-max)) | |
307 (set-buffer nntp-server-buffer) | |
2843 | 308 (apply (function call-process-region) |
87 | 309 (point-min) (point-max) |
310 nnspool-inews-program 'delete t nil nnspool-inews-switches) | |
311 (prog1 | |
312 (or (zerop (buffer-size)) | |
313 ;; If inews returns strings, it must be error message | |
314 ;; unless SPOOLNEWS is defined. | |
315 ;; This condition is very weak, but there is no good rule | |
316 ;; identifying errors when SPOOLNEWS is defined. | |
317 ;; Suggested by ohm@kaba.junet. | |
318 (string-match "spooled" (buffer-string))) | |
319 ;; Make status message by unfolding lines. | |
320 (subst-char-in-region (point-min) (point-max) ?\n ?\\ 'noundo) | |
2843 | 321 (setq nntp-status-string (buffer-string)) |
87 | 322 (erase-buffer)) |
323 )) | |
324 | |
325 | |
326 ;;; | |
327 ;;; Replacement of Low-Level Interface to NNTP Server. | |
328 ;;; | |
329 | |
330 (defun nnspool-open-server-internal (host &optional service) | |
331 "Open connection to news server on HOST by SERVICE (default is nntp)." | |
332 (save-excursion | |
333 (if (not (string-equal host (system-name))) | |
334 (error "NNSPOOL: cannot talk to %s." host)) | |
335 ;; Initialize communication buffer. | |
336 (setq nntp-server-buffer (get-buffer-create " *nntpd*")) | |
337 (set-buffer nntp-server-buffer) | |
338 (buffer-flush-undo (current-buffer)) | |
339 (erase-buffer) | |
340 (kill-all-local-variables) | |
341 (setq case-fold-search t) ;Should ignore case. | |
342 (setq nntp-server-process nil) | |
343 (setq nntp-server-name host) | |
344 ;; It is possible to change kanji-fileio-code in this hook. | |
345 (run-hooks 'nntp-server-hook) | |
346 t | |
347 )) | |
348 | |
349 (defun nnspool-close-server-internal () | |
350 "Close connection to news server." | |
351 (if (get-file-buffer nnspool-history-file) | |
352 (kill-buffer (get-file-buffer nnspool-history-file))) | |
353 (if nntp-server-buffer | |
354 (kill-buffer nntp-server-buffer)) | |
355 (setq nntp-server-buffer nil) | |
356 (setq nntp-server-process nil)) | |
357 | |
358 (defun nnspool-find-article-by-message-id (id) | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
2843
diff
changeset
|
359 "Return full pathname of an article identified by message-ID." |
87 | 360 (save-excursion |
361 (let ((buffer (get-file-buffer nnspool-history-file))) | |
362 (if buffer | |
363 (set-buffer buffer) | |
364 ;; Finding history file may take lots of time. | |
365 (message "Reading history file...") | |
366 (set-buffer (find-file-noselect nnspool-history-file)) | |
367 (message "Reading history file... done"))) | |
368 ;; Search from end of the file. I think this is much faster than | |
369 ;; do from the beginning of the file. | |
370 (goto-char (point-max)) | |
371 (if (re-search-backward | |
372 (concat "^" (regexp-quote id) | |
373 "[ \t].*[ \t]\\([^ \t/]+\\)/\\([0-9]+\\)[ \t]*$") nil t) | |
374 (let ((group (buffer-substring (match-beginning 1) (match-end 1))) | |
375 (number (buffer-substring (match-beginning 2) (match-end 2)))) | |
376 (concat (nnspool-article-pathname | |
377 (nnspool-replace-chars-in-string group ?. ?/)) | |
378 number)) | |
379 ))) | |
380 | |
381 (defun nnspool-find-file (file) | |
382 "Insert FILE in server buffer safely." | |
383 (set-buffer nntp-server-buffer) | |
384 (erase-buffer) | |
385 (condition-case () | |
386 (progn (insert-file-contents file) t) | |
387 (file-error nil) | |
388 )) | |
389 | |
390 (defun nnspool-article-pathname (group) | |
391 "Make pathname for GROUP." | |
392 (concat (file-name-as-directory nnspool-spool-directory) group "/")) | |
393 | |
394 (defun nnspool-replace-chars-in-string (string from to) | |
395 "Replace characters in STRING from FROM to TO." | |
396 (let ((string (substring string 0)) ;Copy string. | |
397 (len (length string)) | |
398 (idx 0)) | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
2843
diff
changeset
|
399 ;; Replace all occurrences of FROM with TO. |
87 | 400 (while (< idx len) |
401 (if (= (aref string idx) from) | |
402 (aset string idx to)) | |
403 (setq idx (1+ idx))) | |
404 string | |
405 )) | |
584 | 406 |
407 (provide 'nnspool) | |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
408 |
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
409 ;;; nnspool.el ends here |