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