Mercurial > emacs
annotate lisp/mail/mspools.el @ 20383:3a76b48c399d
1997-11-27 Richard Stallman <rms@sucrose.ai.mit.edu>
* dired.el (dired-move-to-filename-regexp): Make regexp fussier
about amount of whitespace after month name.
author | Joel N. Weber II <devnull@gnu.org> |
---|---|
date | Sat, 29 Nov 1997 05:21:18 +0000 |
parents | e50604c01474 |
children | 498136447303 |
rev | line source |
---|---|
19034 | 1 ;;; mspools.el --- Show mail spools waiting to be read |
17905 | 2 |
19041
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
3 ;; Copyright (C) 1997 Free Software Foundation, Inc. |
17905 | 4 |
18929 | 5 ;; Author: Stephen Eglen <stephen@cns.ed.ac.uk> |
6 ;; Maintainer: Stephen Eglen <stephen@cns.ed.ac.uk> | |
17905 | 7 ;; Created: 22 Jan 1997 |
18929 | 8 ;; Keywords: mail |
17905 | 9 |
19042
e50604c01474
Update distribution terms.
Richard M. Stallman <rms@gnu.org>
parents:
19041
diff
changeset
|
10 ;; This file is part of GNU Emacs. |
e50604c01474
Update distribution terms.
Richard M. Stallman <rms@gnu.org>
parents:
19041
diff
changeset
|
11 |
e50604c01474
Update distribution terms.
Richard M. Stallman <rms@gnu.org>
parents:
19041
diff
changeset
|
12 ;; GNU Emacs is free software; you can redistribute it and/or modify |
17905 | 13 ;; it under the terms of the GNU General Public License as published by |
14 ;; the Free Software Foundation; either version 2, or (at your option) | |
15 ;; any later version. | |
16 | |
19042
e50604c01474
Update distribution terms.
Richard M. Stallman <rms@gnu.org>
parents:
19041
diff
changeset
|
17 ;; GNU Emacs is distributed in the hope that it will be useful, |
17905 | 18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
25 ;; Boston, MA 02111-1307, USA. | |
26 | |
27 ;;; Commentary: | |
28 | |
29 ;; If you use a mail filter (e.g. procmail, filter) to put mail messages in | |
30 ;; folders, this file will let you see which folders have mail waiting | |
31 ;; to be read in them. It assumes that new mail for the file `folder' | |
32 ;; is written by the filter to a file called `folder.spool'. (If the | |
33 ;; file writes directly to `folder' you may lose mail if new mail | |
34 ;; arrives whilst you are reading the folder in emacs, hence the use | |
35 ;; of a spool file.) For example, the following procmail recipe puts | |
36 ;; any mail with `emacs' in the subject line into the spool file | |
19041
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
37 ;; `emacs.spool', ready to go into the folder `emacs'. |
17905 | 38 ;:0: |
39 ;* ^Subject.*emacs | |
40 ;emacs.spool | |
41 | |
42 ;; It also assumes that all of your spool files and mail folders live | |
43 ;; in the directory pointed to by `mspools-folder-directory', so you must | |
44 ;; set this (see Installation). | |
45 | |
46 ;; When you run `mspools-show', it creates a *spools* buffer containing | |
47 ;; all of the spools in the folder directory that are waiting to be | |
48 ;; read. On each line is the spool name and its size in bytes. Move | |
49 ;; to the line of the folder that you would like to read, and then | |
50 ;; press return or space. The mailer (VM or RMAIL) should then read | |
51 ;; that folder and get the new mail for you. When you return to the | |
52 ;; *spools* buffer, you will either see "*" to indicate that the spool | |
53 ;; has been read, or the remaining unread spools, depending on the | |
54 ;; value of `mspools-update'. | |
55 | |
56 ;; This file should work with both VM and RMAIL. See the variable | |
57 ;; `mspools-using-vm' for details. | |
58 | |
59 | |
60 ;;; Installation | |
61 | |
62 ;; Basic | |
63 ;(autoload 'mspools-show "mspools" "Show outstanding mail spools." t) | |
64 ; Point to directory where spool files and folders are: | |
65 ; (setq mspools-folder-directory "~/MAIL/") | |
19041
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
66 ; |
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
67 ; If you use VM, mspools-folder-directory will default to vm-folder-directory |
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
68 ; unless you have already given it a value. |
17905 | 69 |
70 ;; Extras | |
71 ; possibly bind it to a key: | |
72 ;(global-set-key '[S-f1] 'mspools-show) | |
73 ;(setq mspools-update t) | |
74 | |
75 ;; Interface with the mail filter | |
76 ; We assume that the mail filter drops new mail into the spool | |
77 ; `folder.spool'. If your spool files are something like folder.xyz | |
78 ; for inbox `folder', then do | |
79 ; (setq spool-suffix "xyz") | |
80 ; If you use other conventions for your spool files, this code will | |
81 ; need rewriting. | |
82 | |
83 ;;; Warning for VM users | |
84 ;; Dont use if you are not sure what you are doing! The value of | |
85 ;; vm-spool-files is altered, so you may not be able to read incoming | |
86 ;; mail with VM if this is incorrectly set. | |
87 | |
88 ;; Useful settings for VM | |
89 ;vm-auto-get-new-mail should be t (default t) | |
90 | |
91 ;;; Acknowledgements | |
92 ;; The code for setting up vm-spool-files came from | |
93 ;;http://www-users.informatik.rwth-aachen.de/~berg/archive/procmail/0047.html | |
94 ;; Thanks to jond@mitre.org (Jonathan Doughty) | |
95 | |
96 ;;; TODO | |
97 | |
98 ;; What if users have mail spools in more than one directory? Extend | |
99 ;; mspools-folder-directory to be a list of files? | |
100 | |
101 ;; I was going to add mouse support so that you could click on a line | |
102 ;; to visit the buffer. Tell me if you want it, and I can put the | |
103 ;; code in (I dont use the mouse much, so I havent bothered with it so | |
104 ;; far). | |
105 | |
106 | |
107 ;; Rather than showing size in bytes, could we see the number of msgs | |
108 ;; waiting? (Could be more time demanding / system dependent). | |
109 ;; Perl script counts the number of /^From / occurences. | |
110 ;; ? | |
111 ;; Include date | |
112 ;; (substring (current-time-string (nth 4 (file-attributes "~/INBOX"))) 4 19) | |
113 ;; Maybe just call a perl script to do all the hard work, and | |
114 ;; visualise the results in the buffer. | |
115 | |
116 ;; Shrink wrap the buffer to remove excess white-space? | |
117 | |
118 | |
119 ;;; User Variables | |
120 | |
121 | |
122 (defvar mspools-update nil | |
123 "*Non-nil means update *spools* buffer after visiting any folder.") | |
124 | |
125 (defvar mspools-suffix "spool" | |
126 "*Extension used for spool files (not including full stop).") | |
127 | |
128 ;;; Internal Variables | |
129 | |
130 (defvar mspools-vm-system-mail (getenv "MAIL") | |
131 "Main mailbox used. Only used by VM.") | |
132 | |
133 (defvar mspools-vm-system-mail-crash | |
134 (concat mspools-vm-system-mail ".crash") | |
135 "Crash box for main mailbox. See also `mspools-vm-system-mail'. | |
136 Only used by VM." ) | |
137 | |
138 | |
139 (defvar mspools-files nil | |
140 "List of entries (SPOOL . SIZE) giving spool name and file size.") | |
141 | |
142 (defvar mspools-files-len nil | |
143 "Length of `mspools-files' list.") | |
144 | |
145 (defvar mspools-buffer "*spools*" | |
146 "Name of buffer for displaying spool info.") | |
147 | |
148 (defvar mspools-mode-map nil | |
149 "Keymap for the *spools* buffer.") | |
150 | |
19041
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
151 (defvar mspools-folder-directory |
17905 | 152 (if (boundp 'vm-folder-directory) |
153 vm-folder-directory | |
154 nil) | |
155 "Directory where mail folders are kept. Defaults to | |
156 `vm-folder-directory' if bound else nil. Make sure it has a trailing / | |
157 at the end. ") | |
158 | |
159 | |
160 (defvar mspools-using-vm | |
161 (fboundp 'vm) | |
162 "*Non-nil if VM is used as mail reader, otherwise RMAIL is used.") | |
163 | |
164 | |
165 ;;; Code | |
166 | |
167 ;;; VM Specific code | |
168 (if mspools-using-vm | |
19041
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
169 ;; set up vm if not already loaded. |
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
170 (progn |
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
171 (require 'vm-vars) |
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
172 (if (not vm-init-file-loaded) |
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
173 (load-file vm-init-file)) |
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
174 (if (not mspools-folder-directory) |
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
175 (setq mspools-folder-directory vm-folder-directory)) |
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
176 )) |
17905 | 177 |
178 (defun mspools-set-vm-spool-files () | |
179 "Set value of `vm-spool-files'. Only needed for VM." | |
180 (setq | |
181 vm-spool-files | |
182 (append | |
183 (list | |
184 ;; Main mailbox | |
185 (list vm-primary-inbox | |
186 mspools-vm-system-mail; your mailbox | |
187 mspools-vm-system-mail-crash ; crash for mailbox | |
188 )) | |
189 | |
190 ;; Mailing list inboxes | |
19041
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
191 ;; must have VM already loaded to get vm-folder-directory. |
17905 | 192 (mapcar '(lambda (s) |
193 "make the appropriate entry for vm-spool-files" | |
194 (list | |
195 (concat vm-folder-directory s) | |
196 (concat vm-folder-directory s "." mspools-suffix) | |
197 (concat vm-folder-directory s ".crash"))) | |
198 ;; So I create a vm-spool-files entry for each of those mail drops | |
199 (mapcar 'file-name-sans-extension | |
200 (directory-files vm-folder-directory nil | |
201 (format "^[^.]+\\.%s" mspools-suffix))) | |
202 )) | |
203 )) | |
204 | |
205 | |
206 | |
207 ;;; MSPOOLS-SHOW -- the main function | |
208 (defun mspools-show ( &optional noshow) | |
209 "Show the list of non-empty spool files in the *spools* buffer. | |
210 Buffer is not displayed if SHOW is non-nil." | |
211 (interactive) | |
212 (if (get-buffer mspools-buffer) | |
213 ;; buffer exists | |
214 (progn | |
215 (set-buffer mspools-buffer) | |
216 (setq buffer-read-only nil) | |
217 (delete-region (point-min) (point-max))) | |
218 ;; else buff. doesnt exist so create it | |
219 (get-buffer-create mspools-buffer)) | |
220 | |
221 ;; generate the list of spool files | |
222 (if mspools-using-vm | |
223 (mspools-set-vm-spool-files)) | |
224 | |
225 (mspools-get-spool-files) | |
226 (if (not noshow) (pop-to-buffer mspools-buffer)) | |
227 | |
228 (setq buffer-read-only t) | |
229 (mspools-mode) | |
230 ) | |
231 | |
232 | |
233 | |
234 | |
235 (defun mspools-visit-spool () | |
236 "Visit the folder on the current line of the *spools* buffer." | |
237 (interactive) | |
238 (let ( spool-name folder-name) | |
239 (setq spool-name (mspools-get-spool-name)) | |
240 (setq folder-name (mspools-get-folder-from-spool spool-name)) | |
241 | |
242 ;; put in a little "*" to indicate spool file has been read. | |
243 (if (not mspools-update) | |
244 (save-excursion | |
245 (setq buffer-read-only nil) | |
246 (beginning-of-line) | |
247 (insert "*") | |
248 (delete-char 1) | |
249 (setq buffer-read-only t) | |
250 )) | |
251 | |
252 | |
253 (message "folder %s spool %s" folder-name spool-name) | |
254 (if (eq (count-lines (point-min) | |
255 (save-excursion | |
256 (end-of-line) | |
257 (point))) | |
258 mspools-files-len) | |
259 (next-line (- 1 mspools-files-len)) ;back to top of list | |
260 ;; else just on to next line | |
261 (next-line 1)) | |
262 | |
263 ;; Choose whether to use VM or RMAIL for reading folder. | |
264 (if mspools-using-vm | |
265 (vm-visit-folder (concat mspools-folder-directory folder-name)) | |
266 ;; else using RMAIL | |
267 (rmail (concat mspools-folder-directory folder-name)) | |
268 (setq rmail-inbox-list | |
269 (list (concat mspools-folder-directory spool-name))) | |
270 (rmail-get-new-mail)) | |
271 | |
272 | |
273 (if mspools-update | |
274 ;; generate new list of spools. | |
275 (save-excursion | |
276 (mspools-show-again 'noshow))) | |
277 )) | |
278 | |
279 | |
280 | |
281 | |
282 (defun mspools-get-folder-from-spool (name) | |
283 "Return folder name corresponding to the spool file NAME." | |
284 ;; Simply strip of the extension. | |
285 (file-name-sans-extension name)) | |
286 | |
287 ;; Alternative version if you have more complicated mapping of spool name | |
288 ;; to file name. | |
289 ;(defun get-folder-from-spool-safe (name) | |
290 ; "Return the folder name corresponding to the spool file NAME." | |
291 ; (if (string-match "^\\(.*\\)\.spool$" name) | |
292 ; (substring name (match-beginning 1) (match-end 1)) | |
293 ; (error "Could not extract folder name from spool name %s" name))) | |
294 | |
295 ; test | |
296 ;(mspools-get-folder-from-spool "happy.spool") | |
297 ;(mspools-get-folder-from-spool "happy.sp") | |
298 | |
299 | |
300 | |
301 (defun mspools-get-spool-name () | |
302 "Return the name of the spool on the current line." | |
303 (let ((line-num (1- (count-lines (point-min) | |
304 (save-excursion | |
305 (end-of-line) | |
306 (point)) | |
307 )))) | |
308 (car (nth line-num mspools-files)))) | |
309 | |
310 ;;; Keymap | |
311 | |
312 (if mspools-mode-map | |
313 () | |
314 (setq mspools-mode-map (make-sparse-keymap)) | |
315 | |
316 (define-key mspools-mode-map "\C-c\C-c" 'mspools-visit-spool) | |
317 (define-key mspools-mode-map "\C-m" 'mspools-visit-spool) | |
318 (define-key mspools-mode-map " " 'mspools-visit-spool) | |
319 (define-key mspools-mode-map "?" 'mspools-help) | |
320 (define-key mspools-mode-map "q" 'mspools-quit) | |
321 (define-key mspools-mode-map "g" 'revert-buffer)) | |
322 | |
323 | |
324 ;;; Spools mode functions | |
325 | |
326 (defun mspools-revert-buffer (ignore noconfirm) | |
327 "Re-run mspools-show to revert the *spools* buffer." | |
328 (mspools-show 'noshow)) | |
329 | |
330 (defun mspools-show-again (&optional noshow) | |
331 "Update the *spools* buffer. This is useful if mspools-update is | |
332 nil." | |
333 (interactive) | |
334 (mspools-show noshow)) | |
335 | |
336 (defun mspools-help () | |
337 "Show help for `mspools-mode'." | |
338 (interactive) | |
339 (describe-function 'mspools-mode)) | |
340 | |
341 (defun mspools-quit () | |
342 "Quit the *spools* buffer." | |
343 (interactive) | |
344 (kill-buffer mspools-buffer)) | |
345 | |
346 | |
347 (defun mspools-mode () | |
348 "Major mode for output from mspools-show. | |
349 \\<mspools-mode-map>Move point to one of the items in this buffer, then use | |
350 \\[mspools-visit-spool] to go to the spool that the current line refers to. | |
19041
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
351 \\[revert-buffer] to regenerate the list of spools. |
17905 | 352 \\{mspools-mode-map}" |
353 (kill-all-local-variables) | |
354 (make-local-variable 'revert-buffer-function) | |
355 (setq revert-buffer-function 'mspools-revert-buffer) | |
356 (use-local-map mspools-mode-map) | |
357 (setq major-mode 'mspools-mode) | |
358 (setq mode-name "MSpools") | |
359 ) | |
360 | |
361 | |
362 (defun mspools-get-spool-files () | |
363 "Find the list of spool files and display them in *spools* buffer." | |
364 (let (folders head spool len beg end any) | |
365 (setq folders (directory-files mspools-folder-directory nil | |
366 (format "^[^.]+\\.%s" mspools-suffix))) | |
367 | |
368 | |
369 (setq folders (mapcar 'mspools-size-folder folders)) | |
370 (setq folders (delq nil folders)) | |
371 (setq mspools-files folders) | |
372 (setq mspools-files-len (length mspools-files)) | |
373 (set-buffer mspools-buffer) | |
374 (while folders | |
375 (setq any t) | |
376 (setq head (car folders)) | |
377 (setq spool (car head)) | |
378 (setq len (cdr head)) | |
379 (setq folders (cdr folders)) | |
380 (setq beg (point)) | |
381 (insert (format " %10d %s" len spool)) | |
382 (setq end (point)) | |
383 (insert "\n") | |
384 ;;(put-text-property beg end 'mouse-face 'highlight) | |
385 ) | |
386 (if any | |
387 (delete-char -1)) ;delete last RET | |
388 (goto-char (point-min)) | |
389 )) | |
390 | |
391 | |
392 | |
393 (defun mspools-size-folder (spool) | |
394 "Return (SPOOL . SIZE ) iff SIZE of spool file is non-zero." | |
395 ;; 7th file attribute is the size of the file in bytes. | |
19041
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
396 (let ((file (concat mspools-folder-directory spool)) |
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
397 size) |
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
398 (setq file (or (file-symlink-p file) file)) |
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
399 (setq size (nth 7 (file-attributes file))) |
17905 | 400 (if (> size 0) |
401 (cons spool size) | |
402 ;; else SPOOL is empty | |
403 nil))) | |
404 | |
405 (provide 'mspools) | |
19041
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
406 ;;; mspools.el ends here |
036cc3196550
(mspools-using-vm): Better handling of VM initialization.
Richard M. Stallman <rms@gnu.org>
parents:
19034
diff
changeset
|
407 |