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