Mercurial > emacs
annotate lisp/=mhspool.el @ 24419:30e478cd167e
(shell-command-default-error-buffer): Renamed from
shell-command-on-region-default-error-buffer.
(shell-command-on-region): Mention in echo area when there
is some error output. Mention success or failure, too.
Accumulate multiple error outputs
going forward, with formfeed in between. Display the error buffer
when we have put something in it.
(shell-command): Add the ERROR-BUFFER argument feature.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Mon, 01 Mar 1999 03:19:32 +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 |