1 ;;; mspools.el --- show mail spools waiting to be read
3 ;; Copyright (C) 1997, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
5 ;; Author: Stephen Eglen <stephen@gnu.org>
6 ;; Maintainer: Stephen Eglen <stephen@gnu.org>
7 ;; Created: 22 Jan 1997
9 ;; location: http://www.anc.ed.ac.uk/~stephen/emacs/
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software; you can redistribute it and/or modify
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)
18 ;; GNU Emacs is distributed in the hope that it will be useful,
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.
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., 51 Franklin Street, Fifth Floor,
26 ;; Boston, MA 02110-1301, USA.
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
38 ;; `emacs.spool', ready to go into the folder `emacs'.
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).
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'.
57 ;; This file should work with both VM and RMAIL. See the variable
58 ;; `mspools-using-vm' for details.
60 ;;; Basic installation.
61 ;; (autoload 'mspools-show "mspools" "Show outstanding mail spools." t)
62 ;; (setq mspools-folder-directory "~/MAIL/")
64 ;; If you use VM, mspools-folder-directory will default to vm-folder-directory
65 ;; unless you have already given it a value.
69 ;; (global-set-key '[S-f1] 'mspools-show) ;Bind mspools-show to Shift F1.
70 ;; (setq mspools-update t) ;Automatically update buffer.
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
80 ;; Warning for VM users
81 ;; Don't use if you are not sure what you are doing. The value of
82 ;; vm-spool-files is altered, so you may not be able to read incoming
83 ;; mail with VM if this is incorrectly set.
85 ;; Useful settings for VM
86 ;; vm-auto-get-new-mail should be t (the default).
89 ;; Thanks to jond@mitre.org (Jonathan Doughty) for help with code for
90 ;; setting up vm-spool-files.
94 ;; What if users have mail spools in more than one directory? Extend
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.
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
101 ;; code in (I don't use the mouse much, so I haven't bothered with it
104 ;; Rather than showing size in bytes, could we see the number of msgs
105 ;; waiting? (Could be more time demanding / system dependent).
106 ;; Maybe just call a perl script to do all the hard work, and
107 ;; visualise the results in the buffer.
109 ;; Shrink wrap the buffer to remove excess white-space?
113 (defvar rmail-inbox-list
)
114 (defvar vm-crash-box
)
115 (defvar vm-folder-directory
)
116 (defvar vm-init-file
)
117 (defvar vm-init-file-loaded
)
118 (defvar vm-primary-inbox
)
119 (defvar vm-spool-files
)
123 (defgroup mspools nil
124 "Show mail spools waiting to be read."
126 :link
'(emacs-commentary-link :tag
"Commentary" "mspools.el")
129 (defcustom mspools-update nil
130 "*Non-nil means update *spools* buffer after visiting any folder."
134 (defcustom mspools-suffix
"spool"
135 "*Extension used for spool files (not including full stop)."
139 (defcustom mspools-using-vm
(fboundp 'vm
)
140 "*Non-nil if VM is used as mail reader, otherwise RMAIL is used."
144 (defcustom mspools-folder-directory
145 (if (boundp 'vm-folder-directory
)
148 "*Directory where mail folders are kept. Ensure it has a trailing /.
149 Defaults to `vm-folder-directory' if bound else to ~/MAIL/."
153 (defcustom mspools-vm-system-mail
(or (getenv "MAIL")
154 (concat rmail-spool-directory
156 "*Spool file for main mailbox. Only used by VM.
157 This needs to be set to your primary mail spool - mspools will not run
158 without it. By default this will be set to the environment variable
159 $MAIL. Otherwise it will use `rmail-spool-directory' to guess where
160 your primary spool is. If this fails, set it to something like
161 /usr/spool/mail/login-name."
165 ;;; Internal Variables
167 (defvar mspools-files nil
168 "List of entries (SPOOL . SIZE) giving spool name and file size.")
170 (defvar mspools-files-len nil
171 "Length of `mspools-files' list.")
173 (defvar mspools-buffer
"*spools*"
174 "Name of buffer for displaying spool info.")
176 (defvar mspools-mode-map nil
177 "Keymap for the *spools* buffer.")
183 ;; set up vm if not already loaded.
186 (if (and (not vm-init-file-loaded
) (file-readable-p vm-init-file
))
187 (load-file vm-init-file
))
188 (if (not mspools-folder-directory
)
189 (setq mspools-folder-directory vm-folder-directory
))
192 (defun mspools-set-vm-spool-files ()
193 "Set value of `vm-spool-files'. Only needed for VM."
194 (if (not (file-readable-p mspools-vm-system-mail
))
195 (error "Need to set mspools-vm-system-mail to the spool for primary inbox"))
196 (if (null mspools-folder-directory
)
197 (error "Set `mspools-folder-directory' to where the spool files are"))
203 (list vm-primary-inbox
204 mspools-vm-system-mail
; your mailbox
205 vm-crash-box
;crash for mailbox
208 ;; Mailing list inboxes
209 ;; must have VM already loaded to get vm-folder-directory.
211 "make the appropriate entry for vm-spool-files"
213 (concat mspools-folder-directory s
)
214 (concat mspools-folder-directory s
"." mspools-suffix
)
215 (concat mspools-folder-directory s
".crash")))
216 ;; So I create a vm-spool-files entry for each of those mail drops
217 (mapcar 'file-name-sans-extension
218 (directory-files mspools-folder-directory nil
219 (format "^[^.]+\\.%s" mspools-suffix
)))
223 ;;; MSPOOLS-SHOW -- the main function
224 (defun mspools-show ( &optional noshow
)
225 "Show the list of non-empty spool files in the *spools* buffer.
226 Buffer is not displayed if SHOW is non-nil."
228 (if (get-buffer mspools-buffer
)
231 (set-buffer mspools-buffer
)
232 (setq buffer-read-only nil
)
233 (delete-region (point-min) (point-max)))
234 ;; else buffer doesn't exist so create it
235 (get-buffer-create mspools-buffer
))
237 ;; generate the list of spool files
239 (mspools-set-vm-spool-files))
241 (mspools-get-spool-files)
242 (if (not noshow
) (pop-to-buffer mspools-buffer
))
244 (setq buffer-read-only t
)
248 (defun mspools-visit-spool ()
249 "Visit the folder on the current line of the *spools* buffer."
251 (let ( spool-name folder-name
)
252 (setq spool-name
(mspools-get-spool-name))
253 (if (null spool-name
)
254 (message "No spool on current line")
256 (setq folder-name
(mspools-get-folder-from-spool spool-name
))
258 ;; put in a little "*" to indicate spool file has been read.
259 (if (not mspools-update
)
261 (setq buffer-read-only nil
)
265 (setq buffer-read-only t
)
268 (message "folder %s spool %s" folder-name spool-name
)
269 (if (eq (count-lines (point-min)
274 (next-line (- 1 mspools-files-len
)) ;back to top of list
275 ;; else just on to next line
278 ;; Choose whether to use VM or RMAIL for reading folder.
280 (vm-visit-folder (concat mspools-folder-directory folder-name
))
282 (rmail (concat mspools-folder-directory folder-name
))
283 (setq rmail-inbox-list
284 (list (concat mspools-folder-directory spool-name
)))
285 (rmail-get-new-mail))
289 ;; generate new list of spools.
291 (mspools-show-again 'noshow
))))))
293 (defun mspools-get-folder-from-spool (name)
294 "Return folder name corresponding to the spool file NAME."
295 ;; Simply strip of the extension.
296 (file-name-sans-extension name
))
298 ;; Alternative version if you have more complicated mapping of spool name
300 ;(defun get-folder-from-spool-safe (name)
301 ; "Return the folder name corresponding to the spool file NAME."
302 ; (if (string-match "^\\(.*\\)\.spool$" name)
303 ; (substring name (match-beginning 1) (match-end 1))
304 ; (error "Could not extract folder name from spool name %s" name)))
307 ;(mspools-get-folder-from-spool "happy.spool")
308 ;(mspools-get-folder-from-spool "happy.sp")
310 (defun mspools-get-spool-name ()
311 "Return the name of the spool on the current line."
312 (let ((line-num (1- (count-lines (point-min)
317 (car (nth line-num mspools-files
))))
323 (setq mspools-mode-map
(make-sparse-keymap))
325 (define-key mspools-mode-map
"\C-c\C-c" 'mspools-visit-spool
)
326 (define-key mspools-mode-map
"\C-m" 'mspools-visit-spool
)
327 (define-key mspools-mode-map
" " 'mspools-visit-spool
)
328 (define-key mspools-mode-map
"?" 'mspools-help
)
329 (define-key mspools-mode-map
"q" 'mspools-quit
)
330 (define-key mspools-mode-map
"n" 'next-line
)
331 (define-key mspools-mode-map
"p" 'previous-line
)
332 (define-key mspools-mode-map
"g" 'revert-buffer
))
334 ;;; Spools mode functions
336 (defun mspools-revert-buffer (ignore noconfirm
)
337 "Re-run mspools-show to revert the *spools* buffer."
338 (mspools-show 'noshow
))
340 (defun mspools-show-again (&optional noshow
)
341 "Update the *spools* buffer. This is useful if mspools-update is
344 (mspools-show noshow
))
346 (defun mspools-help ()
347 "Show help for `mspools-mode'."
349 (describe-function 'mspools-mode
))
351 (defun mspools-quit ()
352 "Quit the *spools* buffer."
354 (kill-buffer mspools-buffer
))
356 (defun mspools-mode ()
357 "Major mode for output from mspools-show.
358 \\<mspools-mode-map>Move point to one of the items in this buffer, then use
359 \\[mspools-visit-spool] to go to the spool that the current line refers to.
360 \\[revert-buffer] to regenerate the list of spools.
361 \\{mspools-mode-map}"
362 (kill-all-local-variables)
363 (make-local-variable 'revert-buffer-function
)
364 (setq revert-buffer-function
'mspools-revert-buffer
)
365 (use-local-map mspools-mode-map
)
366 (setq major-mode
'mspools-mode
)
367 (setq mode-name
"MSpools")
368 (run-mode-hooks 'mspools-mode-hook
))
370 (defun mspools-get-spool-files ()
371 "Find the list of spool files and display them in *spools* buffer."
372 (let (folders head spool len beg end any
)
373 (if (null mspools-folder-directory
)
374 (error "Set `mspools-folder-directory' to where the spool files are"))
375 (setq folders
(directory-files mspools-folder-directory nil
376 (format "^[^.]+\\.%s$" mspools-suffix
)))
377 (setq folders
(mapcar 'mspools-size-folder folders
))
378 (setq folders
(delq nil folders
))
379 (setq mspools-files folders
)
380 (setq mspools-files-len
(length mspools-files
))
381 (set-buffer mspools-buffer
)
384 (setq head
(car folders
))
385 (setq spool
(car head
))
386 (setq len
(cdr head
))
387 (setq folders
(cdr folders
))
389 (insert (format " %10d %s" len spool
))
392 ;;(put-text-property beg end 'mouse-face 'highlight)
395 (delete-char -
1)) ;delete last RET
396 (goto-char (point-min))
399 (defun mspools-size-folder (spool)
400 "Return (SPOOL . SIZE ) iff SIZE of spool file is non-zero."
401 ;; 7th file attribute is the size of the file in bytes.
402 (let ((file (concat mspools-folder-directory spool
))
404 (setq file
(or (file-symlink-p file
) file
))
405 (setq size
(nth 7 (file-attributes file
)))
406 ;; size could be nil if the sym-link points to a non-existent file
407 ;; so check this first.
408 (if (and size
(> size
0))
410 ;; else SPOOL is empty
415 ;;; arch-tag: 8990b3ee-68c8-4892-98f1-51a735c8bac6
416 ;;; mspools.el ends here