1 ;;; MSPOOLS.EL --- Show mail spools waiting to be read
3 ;; Copyright (C) 1997 Stephen Eglen
5 ;; Author: Stephen Eglen <stephene@cogs.susx.ac.uk>
6 ;; Maintainer: Stephen Eglen <stephene@cogs.susx.ac.uk>
7 ;; Created: 22 Jan 1997
12 ;; This program is free software; you can redistribute it and/or modify
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)
17 ;; This program is distributed in the hope that it will be useful,
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.
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.
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
37 ;; `apple.spool', ready to go into the folder `emacs'.
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).
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'.
56 ;; This file should work with both VM and RMAIL. See the variable
57 ;; `mspools-using-vm' for details.
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/")
68 ; possibly bind it to a key:
69 ;(global-set-key '[S-f1] 'mspools-show)
70 ;(setq mspools-update t)
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 spool-suffix "xyz")
77 ; If you use other conventions for your spool files, this code will
80 ;;; Warning for VM users
81 ;; Dont 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 (default t)
89 ;; The code for setting up vm-spool-files came from
90 ;;http://www-users.informatik.rwth-aachen.de/~berg/archive/procmail/0047.html
91 ;; Thanks to jond@mitre.org (Jonathan Doughty)
95 ;; What if users have mail spools in more than one directory? Extend
96 ;; mspools-folder-directory to be a list of files?
98 ;; I was going to add mouse support so that you could click on a line
99 ;; to visit the buffer. Tell me if you want it, and I can put the
100 ;; code in (I dont use the mouse much, so I havent bothered with it so
104 ;; Rather than showing size in bytes, could we see the number of msgs
105 ;; waiting? (Could be more time demanding / system dependent).
106 ;; Perl script counts the number of /^From / occurences.
109 ;; (substring (current-time-string (nth 4 (file-attributes "~/INBOX"))) 4 19)
110 ;; Maybe just call a perl script to do all the hard work, and
111 ;; visualise the results in the buffer.
113 ;; Shrink wrap the buffer to remove excess white-space?
119 (defvar mspools-update nil
120 "*Non-nil means update *spools* buffer after visiting any folder.")
122 (defvar mspools-suffix "spool"
123 "*Extension used for spool files (not including full stop).")
125 ;;; Internal Variables
127 (defvar mspools-vm-system-mail (getenv "MAIL")
128 "Main mailbox used. Only used by VM.")
130 (defvar mspools-vm-system-mail-crash
131 (concat mspools-vm-system-mail ".crash")
132 "Crash box for main mailbox. See also `mspools-vm-system-mail'.
136 (defvar mspools-files nil
137 "List of entries (SPOOL . SIZE) giving spool name and file size.")
139 (defvar mspools-files-len nil
140 "Length of `mspools-files' list.")
142 (defvar mspools-buffer "*spools*"
143 "Name of buffer for displaying spool info.")
145 (defvar mspools-mode-map nil
146 "Keymap for the *spools* buffer.")
148 (defvar mspools-folder-directory
149 (if (boundp 'vm-folder-directory)
152 "Directory where mail folders are kept. Defaults to
153 `vm-folder-directory' if bound else nil. Make sure it has a trailing /
157 (defvar mspools-using-vm
159 "*Non-nil if VM is used as mail reader, otherwise RMAIL is used.")
168 (defun mspools-set-vm-spool-files ()
169 "Set value of `vm-spool-files'. Only needed for VM."
175 (list vm-primary-inbox
176 mspools-vm-system-mail; your mailbox
177 mspools-vm-system-mail-crash ; crash for mailbox
180 ;; Mailing list inboxes
182 "make the appropriate entry for vm-spool-files"
184 (concat vm-folder-directory s)
185 (concat vm-folder-directory s "." mspools-suffix)
186 (concat vm-folder-directory s ".crash")))
187 ;; So I create a vm-spool-files entry for each of those mail drops
188 (mapcar 'file-name-sans-extension
189 (directory-files vm-folder-directory nil
190 (format "^[^.]+\\.%s" mspools-suffix)))
196 ;;; MSPOOLS-SHOW -- the main function
197 (defun mspools-show ( &optional noshow)
198 "Show the list of non-empty spool files in the *spools* buffer.
199 Buffer is not displayed if SHOW is non-nil."
201 (if (get-buffer mspools-buffer)
204 (set-buffer mspools-buffer)
205 (setq buffer-read-only nil)
206 (delete-region (point-min) (point-max)))
207 ;; else buff. doesnt exist so create it
208 (get-buffer-create mspools-buffer))
210 ;; generate the list of spool files
212 (mspools-set-vm-spool-files))
214 (mspools-get-spool-files)
215 (if (not noshow) (pop-to-buffer mspools-buffer))
217 (setq buffer-read-only t)
224 (defun mspools-visit-spool ()
225 "Visit the folder on the current line of the *spools* buffer."
227 (let ( spool-name folder-name)
228 (setq spool-name (mspools-get-spool-name))
229 (setq folder-name (mspools-get-folder-from-spool spool-name))
231 ;; put in a little "*" to indicate spool file has been read.
232 (if (not mspools-update)
234 (setq buffer-read-only nil)
238 (setq buffer-read-only t)
242 (message "folder %s spool %s" folder-name spool-name)
243 (if (eq (count-lines (point-min)
248 (next-line (- 1 mspools-files-len)) ;back to top of list
249 ;; else just on to next line
252 ;; Choose whether to use VM or RMAIL for reading folder.
254 (vm-visit-folder (concat mspools-folder-directory folder-name))
256 (rmail (concat mspools-folder-directory folder-name))
257 (setq rmail-inbox-list
258 (list (concat mspools-folder-directory spool-name)))
259 (rmail-get-new-mail))
263 ;; generate new list of spools.
265 (mspools-show-again 'noshow)))
271 (defun mspools-get-folder-from-spool (name)
272 "Return folder name corresponding to the spool file NAME."
273 ;; Simply strip of the extension.
274 (file-name-sans-extension name))
276 ;; Alternative version if you have more complicated mapping of spool name
278 ;(defun get-folder-from-spool-safe (name)
279 ; "Return the folder name corresponding to the spool file NAME."
280 ; (if (string-match "^\\(.*\\)\.spool$" name)
281 ; (substring name (match-beginning 1) (match-end 1))
282 ; (error "Could not extract folder name from spool name %s" name)))
285 ;(mspools-get-folder-from-spool "happy.spool")
286 ;(mspools-get-folder-from-spool "happy.sp")
290 (defun mspools-get-spool-name ()
291 "Return the name of the spool on the current line."
292 (let ((line-num (1- (count-lines (point-min)
297 (car (nth line-num mspools-files))))
303 (setq mspools-mode-map (make-sparse-keymap))
305 (define-key mspools-mode-map "\C-c\C-c" 'mspools-visit-spool)
306 (define-key mspools-mode-map "\C-m" 'mspools-visit-spool)
307 (define-key mspools-mode-map " " 'mspools-visit-spool)
308 (define-key mspools-mode-map "?" 'mspools-help)
309 (define-key mspools-mode-map "q" 'mspools-quit)
310 (define-key mspools-mode-map "g" 'revert-buffer))
313 ;;; Spools mode functions
315 (defun mspools-revert-buffer (ignore noconfirm)
316 "Re-run mspools-show to revert the *spools* buffer."
317 (mspools-show 'noshow))
319 (defun mspools-show-again (&optional noshow)
320 "Update the *spools* buffer. This is useful if mspools-update is
323 (mspools-show noshow))
325 (defun mspools-help ()
326 "Show help for `mspools-mode'."
328 (describe-function 'mspools-mode))
330 (defun mspools-quit ()
331 "Quit the *spools* buffer."
333 (kill-buffer mspools-buffer))
336 (defun mspools-mode ()
337 "Major mode for output from mspools-show.
338 \\<mspools-mode-map>Move point to one of the items in this buffer, then use
339 \\[mspools-visit-spool] to go to the spool that the current line refers to.
340 \\[mspools-show-again] to regenerate the list of spools.
341 \\{mspools-mode-map}"
342 (kill-all-local-variables)
343 (make-local-variable 'revert-buffer-function)
344 (setq revert-buffer-function 'mspools-revert-buffer)
345 (use-local-map mspools-mode-map)
346 (setq major-mode 'mspools-mode)
347 (setq mode-name "MSpools")
351 (defun mspools-get-spool-files ()
352 "Find the list of spool files and display them in *spools* buffer."
353 (let (folders head spool len beg end any)
354 (setq folders (directory-files mspools-folder-directory nil
355 (format "^[^.]+\\.%s" mspools-suffix)))
358 (setq folders (mapcar 'mspools-size-folder folders))
359 (setq folders (delq nil folders))
360 (setq mspools-files folders)
361 (setq mspools-files-len (length mspools-files))
362 (set-buffer mspools-buffer)
365 (setq head (car folders))
366 (setq spool (car head))
367 (setq len (cdr head))
368 (setq folders (cdr folders))
370 (insert (format " %10d %s" len spool))
373 ;;(put-text-property beg end 'mouse-face 'highlight)
376 (delete-char -1)) ;delete last RET
377 (goto-char (point-min))
382 (defun mspools-size-folder (spool)
383 "Return (SPOOL . SIZE ) iff SIZE of spool file is non-zero."
384 ;; 7th file attribute is the size of the file in bytes.
386 (file-attributes (concat mspools-folder-directory spool)))))
387 ;; todo (if (and (not (null size)) (> size 0))
390 ;; else SPOOL is empty
394 ;;; MSPOOLS.EL ends here