Mercurial > emacs
annotate lisp/=mhspool.el @ 17692:426dde653028 gnumach-release-1-1 gnumach-release-1-1-1 libc-970508 libc-970509 libc-970510 libc-970511 libc-970512 libc-970513 libc-970514 libc-970515 libc-970516 libc-970517 libc-970518 libc-970519 libc-970520 libc-970521 libc-970522 libc-970523 libc-970524 libc-970525 libc-970526 libc-970527 libc-970528 libc-970529 libc-970530 libc-970531 libc-970601 libc-970602 libc-970603 libc-970604 libc-970605
Recognize either / or - as a machine/suptype separator from uname -m
to cope with older systems that have the older uname.
author | Thomas Bushnell, BSG <thomas@gnu.org> |
---|---|
date | Wed, 07 May 1997 19:19:04 +0000 |
parents | 507f64624555 |
children |
rev | line source |
---|---|
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
1 ;;; mhspool.el --- MH folder access using NNTP for GNU Emacs |
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
2 |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
3 ;; Copyright (C) 1988, 1989, 1990, 1993 Free Software Foundation, Inc. |
840
113281b361ec
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
811
diff
changeset
|
4 |
791
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
5 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
6 ;; Maintainer: FSF |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
791
diff
changeset
|
7 ;; Keywords: mail, news |
791
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
8 |
87 | 9 ;; This file is part of GNU Emacs. |
10 | |
896 | 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. | |
87 | 15 |
896 | 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 | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
87 | 24 |
2232
4f9d60f7de9d
Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
896
diff
changeset
|
25 ;;; Commentary: |
87 | 26 |
27 ;; This package enables you to read mail or articles in MH folders, or | |
28 ;; articles saved by GNUS. In any case, the file names of mail or | |
29 ;; articles must consist of only numeric letters. | |
30 | |
31 ;; Before using this package, you have to create a server specific | |
32 ;; startup file according to the directory which you want to read. For | |
33 ;; example, if you want to read mail under the directory named | |
34 ;; `~/Mail', the file must be a file named `.newsrc-:Mail'. (There is | |
35 ;; no way to specify hierarchical directory now.) In this case, the | |
36 ;; name of the NNTP server passed to GNUS must be `:Mail'. | |
37 | |
2232
4f9d60f7de9d
Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
896
diff
changeset
|
38 ;;; Code: |
791
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
39 |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
40 (require 'nntp) |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
41 |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
42 (defvar mhspool-list-folders-method |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
43 (function mhspool-list-folders-using-sh) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
44 "*Function to list files in folders. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
45 The function should accept a directory as its argument, and fill the |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
46 current buffer with file and directory names. The output format must |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
47 be the same as that of 'ls -R1'. Two functions |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
48 mhspool-list-folders-using-ls and mhspool-list-folders-using-sh are |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
49 provided now. I suppose the later is faster.") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
50 |
87 | 51 (defvar mhspool-list-directory-switches '("-R") |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
2843
diff
changeset
|
52 "*Switches for mhspool-list-folders-using-ls to pass to `ls' for getting file lists. |
87 | 53 One entry should appear on one line. You may need to add `-1' option.") |
54 | |
55 | |
56 | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
57 (defconst mhspool-version "MHSPOOL 1.8" |
87 | 58 "Version numbers of this version of MHSPOOL.") |
59 | |
60 (defvar mhspool-spool-directory "~/Mail" | |
61 "Private mail directory.") | |
62 | |
63 (defvar mhspool-current-directory nil | |
64 "Current news group directory.") | |
65 | |
66 ;;; | |
67 ;;; Replacement of Extended Command for retrieving many headers. | |
68 ;;; | |
69 | |
70 (defun mhspool-retrieve-headers (sequence) | |
71 "Return list of article headers specified by SEQUENCE of article id. | |
72 The format of list is | |
73 `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'. | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
74 If there is no References: field, In-Reply-To: field is used instead. |
87 | 75 Reader macros for the vector are defined as `nntp-header-FIELD'. |
76 Writer macros for the vector are defined as `nntp-set-header-FIELD'. | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
77 Newsgroup must be selected before calling this." |
87 | 78 (save-excursion |
79 (set-buffer nntp-server-buffer) | |
80 ;;(erase-buffer) | |
81 (let ((file nil) | |
82 (number (length sequence)) | |
83 (count 0) | |
84 (headers nil) ;Result list. | |
85 (article 0) | |
86 (subject nil) | |
87 (message-id nil) | |
88 (from nil) | |
89 (xref nil) | |
90 (lines 0) | |
91 (date nil) | |
92 (references nil)) | |
93 (while sequence | |
94 ;;(nntp-send-strings-to-server "HEAD" (car sequence)) | |
95 (setq article (car sequence)) | |
96 (setq file | |
97 (concat mhspool-current-directory (prin1-to-string article))) | |
98 (if (and (file-exists-p file) | |
99 (not (file-directory-p file))) | |
100 (progn | |
101 (erase-buffer) | |
102 (insert-file-contents file) | |
103 ;; Make message body invisible. | |
104 (goto-char (point-min)) | |
105 (search-forward "\n\n" nil 'move) | |
106 (narrow-to-region (point-min) (point)) | |
107 ;; Fold continuation lines. | |
108 (goto-char (point-min)) | |
109 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) | |
110 (replace-match " " t t)) | |
111 ;; Make it possible to search for `\nFIELD'. | |
112 (goto-char (point-min)) | |
113 (insert "\n") | |
114 ;; Extract From: | |
115 (goto-char (point-min)) | |
116 (if (search-forward "\nFrom: " nil t) | |
117 (setq from (buffer-substring | |
118 (point) | |
119 (save-excursion (end-of-line) (point)))) | |
120 (setq from "(Unknown User)")) | |
121 ;; Extract Subject: | |
122 (goto-char (point-min)) | |
123 (if (search-forward "\nSubject: " nil t) | |
124 (setq subject (buffer-substring | |
125 (point) | |
126 (save-excursion (end-of-line) (point)))) | |
127 (setq subject "(None)")) | |
128 ;; Extract Message-ID: | |
129 (goto-char (point-min)) | |
130 (if (search-forward "\nMessage-ID: " nil t) | |
131 (setq message-id (buffer-substring | |
132 (point) | |
133 (save-excursion (end-of-line) (point)))) | |
134 (setq message-id nil)) | |
135 ;; Extract Date: | |
136 (goto-char (point-min)) | |
137 (if (search-forward "\nDate: " nil t) | |
138 (setq date (buffer-substring | |
139 (point) | |
140 (save-excursion (end-of-line) (point)))) | |
141 (setq date nil)) | |
142 ;; Extract Lines: | |
143 (goto-char (point-min)) | |
144 (if (search-forward "\nLines: " nil t) | |
145 (setq lines (string-to-int | |
146 (buffer-substring | |
147 (point) | |
148 (save-excursion (end-of-line) (point))))) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
149 ;; Count lines since there is no lines field in most cases. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
150 (setq lines |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
151 (save-restriction |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
152 (goto-char (point-max)) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
153 (widen) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
154 (count-lines (point) (point-max))))) |
87 | 155 ;; Extract Xref: |
156 (goto-char (point-min)) | |
157 (if (search-forward "\nXref: " nil t) | |
158 (setq xref (buffer-substring | |
159 (point) | |
160 (save-excursion (end-of-line) (point)))) | |
161 (setq xref nil)) | |
162 ;; Extract References: | |
163 ;; If no References: field, use In-Reply-To: field instead. | |
164 ;; Suggested by tanaka@flab.fujitsu.co.jp (Hiroshi TANAKA). | |
165 (goto-char (point-min)) | |
166 (if (or (search-forward "\nReferences: " nil t) | |
167 (search-forward "\nIn-Reply-To: " nil t)) | |
168 (setq references (buffer-substring | |
169 (point) | |
170 (save-excursion (end-of-line) (point)))) | |
171 (setq references nil)) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
172 ;; Collect valid article only. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
173 (and article |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
174 message-id |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
175 (setq headers |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
176 (cons (vector article subject from |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
177 xref lines date |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
178 message-id references) headers))) |
87 | 179 )) |
180 (setq sequence (cdr sequence)) | |
181 (setq count (1+ count)) | |
182 (and (numberp nntp-large-newsgroup) | |
183 (> number nntp-large-newsgroup) | |
184 (zerop (% count 20)) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
185 (message "MHSPOOL: Receiving headers... %d%%" |
87 | 186 (/ (* count 100) number))) |
187 ) | |
188 (and (numberp nntp-large-newsgroup) | |
189 (> number nntp-large-newsgroup) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
190 (message "MHSPOOL: Receiving headers... done")) |
87 | 191 (nreverse headers) |
192 ))) | |
193 | |
194 | |
195 ;;; | |
196 ;;; Replacement of NNTP Raw Interface. | |
197 ;;; | |
198 | |
199 (defun mhspool-open-server (host &optional service) | |
200 "Open news server on HOST. | |
201 If HOST is nil, use value of environment variable `NNTPSERVER'. | |
202 If optional argument SERVICE is non-nil, open by the service name." | |
203 (let ((host (or host (getenv "NNTPSERVER"))) | |
204 (status nil)) | |
205 ;; Get directory name from HOST name. | |
206 (if (string-match ":\\(.+\\)$" host) | |
207 (progn | |
208 (setq mhspool-spool-directory | |
209 (file-name-as-directory | |
210 (expand-file-name | |
211 (substring host (match-beginning 1) (match-end 1)) | |
212 (expand-file-name "~/" nil)))) | |
213 (setq host (system-name))) | |
214 (setq mhspool-spool-directory nil)) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
215 (setq nntp-status-string "") |
87 | 216 (cond ((and (stringp host) |
217 (stringp mhspool-spool-directory) | |
218 (file-directory-p mhspool-spool-directory) | |
219 (string-equal host (system-name))) | |
220 (setq status (mhspool-open-server-internal host service))) | |
221 ((string-equal host (system-name)) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
222 (setq nntp-status-string |
87 | 223 (format "No such directory: %s. Goodbye." |
224 mhspool-spool-directory))) | |
225 ((null host) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
226 (setq nntp-status-string "NNTP server is not specified.")) |
87 | 227 (t |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
228 (setq nntp-status-string |
87 | 229 (format "MHSPOOL: cannot talk to %s." host))) |
230 ) | |
231 status | |
232 )) | |
233 | |
234 (defun mhspool-close-server () | |
235 "Close news server." | |
236 (mhspool-close-server-internal)) | |
237 | |
238 (fset 'mhspool-request-quit (symbol-function 'mhspool-close-server)) | |
239 | |
240 (defun mhspool-server-opened () | |
241 "Return server process status, T or NIL. | |
242 If the stream is opened, return T, otherwise return NIL." | |
243 (and nntp-server-buffer | |
244 (get-buffer nntp-server-buffer))) | |
245 | |
246 (defun mhspool-status-message () | |
247 "Return server status response as string." | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
248 nntp-status-string |
87 | 249 ) |
250 | |
251 (defun mhspool-request-article (id) | |
252 "Select article by message ID (or number)." | |
253 (let ((file (concat mhspool-current-directory (prin1-to-string id)))) | |
254 (if (and (stringp file) | |
255 (file-exists-p file) | |
256 (not (file-directory-p file))) | |
257 (save-excursion | |
258 (mhspool-find-file file))) | |
259 )) | |
260 | |
261 (defun mhspool-request-body (id) | |
262 "Select article body by message ID (or number)." | |
263 (if (mhspool-request-article id) | |
264 (save-excursion | |
265 (set-buffer nntp-server-buffer) | |
266 (goto-char (point-min)) | |
267 (if (search-forward "\n\n" nil t) | |
268 (delete-region (point-min) (point))) | |
269 t | |
270 ) | |
271 )) | |
272 | |
273 (defun mhspool-request-head (id) | |
274 "Select article head by message ID (or number)." | |
275 (if (mhspool-request-article id) | |
276 (save-excursion | |
277 (set-buffer nntp-server-buffer) | |
278 (goto-char (point-min)) | |
279 (if (search-forward "\n\n" nil t) | |
280 (delete-region (1- (point)) (point-max))) | |
281 t | |
282 ) | |
283 )) | |
284 | |
285 (defun mhspool-request-stat (id) | |
286 "Select article by message ID (or number)." | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
287 (setq nntp-status-string "MHSPOOL: STAT is not implemented.") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
288 nil |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
289 ) |
87 | 290 |
291 (defun mhspool-request-group (group) | |
292 "Select news GROUP." | |
293 (cond ((file-directory-p | |
294 (mhspool-article-pathname group)) | |
295 ;; Mail/NEWS.GROUP/N | |
296 (setq mhspool-current-directory | |
297 (mhspool-article-pathname group))) | |
298 ((file-directory-p | |
299 (mhspool-article-pathname | |
300 (mhspool-replace-chars-in-string group ?. ?/))) | |
301 ;; Mail/NEWS/GROUP/N | |
302 (setq mhspool-current-directory | |
303 (mhspool-article-pathname | |
304 (mhspool-replace-chars-in-string group ?. ?/)))) | |
305 )) | |
306 | |
307 (defun mhspool-request-list () | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
308 "List active newsgoups." |
87 | 309 (save-excursion |
310 (let* ((newsgroup nil) | |
311 (articles nil) | |
312 (directory (file-name-as-directory | |
313 (expand-file-name mhspool-spool-directory nil))) | |
314 (folder-regexp (concat "^" (regexp-quote directory) "\\(.+\\):$")) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
315 (buffer (get-buffer-create " *MHSPOOL File List*"))) |
87 | 316 (set-buffer nntp-server-buffer) |
317 (erase-buffer) | |
318 (set-buffer buffer) | |
319 (erase-buffer) | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
320 ;; (apply 'call-process |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
321 ;; "ls" nil t nil |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
322 ;; (append mhspool-list-directory-switches (list directory))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
323 (funcall mhspool-list-folders-method directory) |
87 | 324 (goto-char (point-min)) |
325 (while (re-search-forward folder-regexp nil t) | |
326 (setq newsgroup | |
327 (mhspool-replace-chars-in-string | |
328 (buffer-substring (match-beginning 1) (match-end 1)) ?/ ?.)) | |
329 (setq articles nil) | |
330 (forward-line 1) ;(beginning-of-line) | |
331 ;; Thank nobu@flab.fujitsu.junet for his bug fixes. | |
332 (while (and (not (eobp)) | |
333 (not (looking-at "^$"))) | |
334 (if (looking-at "^[0-9]+$") | |
335 (setq articles | |
336 (cons (string-to-int | |
337 (buffer-substring | |
338 (match-beginning 0) (match-end 0))) | |
339 articles))) | |
340 (forward-line 1)) | |
341 (if articles | |
342 (princ (format "%s %d %d n\n" newsgroup | |
343 (apply (function max) articles) | |
344 (apply (function min) articles)) | |
345 nntp-server-buffer)) | |
346 ) | |
347 (kill-buffer buffer) | |
348 (set-buffer nntp-server-buffer) | |
349 (buffer-size) | |
350 ))) | |
351 | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
352 (defun mhspool-request-list-newsgroups () |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
353 "List newsgoups (defined in NNTP2)." |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
354 (setq nntp-status-string "MHSPOOL: LIST NEWSGROUPS is not implemented.") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
355 nil |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
356 ) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
357 |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
358 (defun mhspool-request-list-distributions () |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
359 "List distributions (defined in NNTP2)." |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
360 (setq nntp-status-string "MHSPOOL: LIST DISTRIBUTIONS is not implemented.") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
361 nil |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
362 ) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
363 |
87 | 364 (defun mhspool-request-last () |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
365 "Set current article pointer to the previous article |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
366 in the current news group." |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
367 (setq nntp-status-string "MHSPOOL: LAST is not implemented.") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
368 nil |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
369 ) |
87 | 370 |
371 (defun mhspool-request-next () | |
372 "Advance current article pointer." | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
373 (setq nntp-status-string "MHSPOOL: NEXT is not implemented.") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
374 nil |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
375 ) |
87 | 376 |
377 (defun mhspool-request-post () | |
378 "Post a new news in current buffer." | |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
379 (setq nntp-status-string "MHSPOOL: POST: what do you mean?") |
87 | 380 nil |
381 ) | |
382 | |
383 | |
384 ;;; | |
385 ;;; Replacement of Low-Level Interface to NNTP Server. | |
386 ;;; | |
387 | |
388 (defun mhspool-open-server-internal (host &optional service) | |
389 "Open connection to news server on HOST by SERVICE (default is nntp)." | |
390 (save-excursion | |
391 (if (not (string-equal host (system-name))) | |
392 (error "MHSPOOL: cannot talk to %s." host)) | |
393 ;; Initialize communication buffer. | |
394 (setq nntp-server-buffer (get-buffer-create " *nntpd*")) | |
395 (set-buffer nntp-server-buffer) | |
396 (buffer-flush-undo (current-buffer)) | |
397 (erase-buffer) | |
398 (kill-all-local-variables) | |
399 (setq case-fold-search t) ;Should ignore case. | |
400 (setq nntp-server-process nil) | |
401 (setq nntp-server-name host) | |
402 ;; It is possible to change kanji-fileio-code in this hook. | |
403 (run-hooks 'nntp-server-hook) | |
404 t | |
405 )) | |
406 | |
407 (defun mhspool-close-server-internal () | |
408 "Close connection to news server." | |
409 (if nntp-server-buffer | |
410 (kill-buffer nntp-server-buffer)) | |
411 (setq nntp-server-buffer nil) | |
412 (setq nntp-server-process nil)) | |
413 | |
414 (defun mhspool-find-file (file) | |
415 "Insert FILE in server buffer safely." | |
416 (set-buffer nntp-server-buffer) | |
417 (erase-buffer) | |
418 (condition-case () | |
419 (progn | |
420 (insert-file-contents file) | |
421 (goto-char (point-min)) | |
422 ;; If there is no body, `^L' appears at end of file. Special | |
423 ;; hack for MH folder. | |
424 (and (search-forward "\n\n" nil t) | |
425 (string-equal (buffer-substring (point) (point-max)) "\^L") | |
426 (delete-char 1)) | |
427 t | |
428 ) | |
429 (file-error nil) | |
430 )) | |
431 | |
432 (defun mhspool-article-pathname (group) | |
433 "Make pathname for GROUP." | |
434 (concat (file-name-as-directory mhspool-spool-directory) group "/")) | |
435 | |
436 (defun mhspool-replace-chars-in-string (string from to) | |
437 "Replace characters in STRING from FROM to TO." | |
438 (let ((string (substring string 0)) ;Copy string. | |
439 (len (length string)) | |
440 (idx 0)) | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
2843
diff
changeset
|
441 ;; Replace all occurrences of FROM with TO. |
87 | 442 (while (< idx len) |
443 (if (= (aref string idx) from) | |
444 (aset string idx to)) | |
445 (setq idx (1+ idx))) | |
446 string | |
447 )) | |
584 | 448 |
2843
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
449 |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
450 ;; Methods for listing files in folders. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
451 |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
452 (defun mhspool-list-folders-using-ls (directory) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
453 "List files in folders under DIRECTORY using 'ls'." |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
454 (apply 'call-process |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
455 "ls" nil t nil |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
456 (append mhspool-list-directory-switches (list directory)))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
457 |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
458 ;; Basic ideas by tanaka@flab.fujitsu.co.jp (Hiroshi TANAKA) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
459 |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
460 (defun mhspool-list-folders-using-sh (directory) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
461 "List files in folders under DIRECTORY using '/bin/sh'." |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
462 (let ((buffer (current-buffer)) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
463 (script (get-buffer-create " *MHSPOOL Shell Script Buffer*"))) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
464 (save-excursion |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
465 (save-restriction |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
466 (set-buffer script) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
467 (erase-buffer) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
468 ;; /bin/sh script which does 'ls -R'. |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
469 (insert |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
470 "PS2= |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
471 ffind() { |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
472 cd $1; echo $1: |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
473 ls -1 |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
474 echo |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
475 for j in `echo *[a-zA-Z]*` |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
476 do |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
477 if [ -d $1/$j ]; then |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
478 ffind $1/$j |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
479 fi |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
480 done |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
481 } |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
482 cd " directory "; ffind `pwd`; exit 0\n") |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
483 (call-process-region (point-min) (point-max) "sh" nil buffer nil) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
484 )) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
485 (kill-buffer script) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
486 )) |
cd90d49526ae
Version 3.15 from Umeda.
Richard M. Stallman <rms@gnu.org>
parents:
2232
diff
changeset
|
487 |
584 | 488 (provide 'mhspool) |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
489 |
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
490 ;;; mhspool.el ends here |