1 ;;; mspools.el --- show mail spools waiting to be read
3 ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005,
4 ;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
6 ;; Author: Stephen Eglen <stephen@gnu.org>
7 ;; Maintainer: Stephen Eglen <stephen@gnu.org>
8 ;; Created: 22 Jan 1997
10 ;; location: http://www.anc.ed.ac.uk/~stephen/emacs/
12 ;; This file is part of GNU Emacs.
14 ;; GNU Emacs is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
19 ;; GNU Emacs is distributed in the hope that it will be useful,
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.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
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 ;; `emacs.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.
59 ;;; Basic installation.
60 ;; (autoload 'mspools-show "mspools" "Show outstanding mail spools." t)
61 ;; (setq mspools-folder-directory "~/MAIL/")
63 ;; If you use VM, mspools-folder-directory will default to vm-folder-directory
64 ;; unless you have already given it a value.
68 ;; (global-set-key '[S-f1] 'mspools-show) ;Bind mspools-show to Shift F1.
69 ;; (setq mspools-update t) ;Automatically update buffer.
71 ;; Interface with the mail filter.
72 ;; We assume that the mail filter drops new mail into the spool
73 ;; `folder.spool'. If your spool files are something like folder.xyz
74 ;; for inbox `folder', then do:
75 ;; (setq mspools-suffix "xyz")
76 ;; If you use other conventions for your spool files, this code will
79 ;; Warning for VM users
80 ;; Don't use if you are not sure what you are doing. The value of
81 ;; vm-spool-files is altered, so you may not be able to read incoming
82 ;; mail with VM if this is incorrectly set.
84 ;; Useful settings for VM
85 ;; vm-auto-get-new-mail should be t (the default).
88 ;; Thanks to jond@mitre.org (Jonathan Doughty) for help with code for
89 ;; setting up vm-spool-files.
93 ;; What if users have mail spools in more than one directory? Extend
94 ;; mspools-folder-directory to be a list of directories? Currently,
95 ;; if mail spools are in other directories, the way to read them is to
96 ;; put a symbolic link to the spool into the mspools-folder-directory.
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 don't use the mouse much, so I haven't bothered with it
103 ;; Rather than showing size in bytes, could we see the number of msgs
104 ;; waiting? (Could be more time demanding / system dependent).
105 ;; Maybe just call a perl script to do all the hard work, and
106 ;; visualize the results in the buffer.
108 ;; Shrink wrap the buffer to remove excess white-space?
112 (defvar rmail-inbox-list)
113 (defvar vm-crash-box)
114 (defvar vm-folder-directory)
115 (defvar vm-init-file)
116 (defvar vm-init-file-loaded)
117 (defvar vm-primary-inbox)
118 (defvar vm-spool-files)
122 (defgroup mspools nil
123 "Show mail spools waiting to be read."
125 :link '(emacs-commentary-link :tag "Commentary" "mspools.el")
128 (defcustom mspools-update nil
129 "*Non-nil means update *spools* buffer after visiting any folder."
133 (defcustom mspools-suffix "spool"
134 "*Extension used for spool files (not including full stop)."
138 (defcustom mspools-using-vm (fboundp 'vm)
139 "*Non-nil if VM is used as mail reader, otherwise RMAIL is used."
143 (defcustom mspools-folder-directory
144 (if (boundp 'vm-folder-directory)
147 "*Directory where mail folders are kept. Ensure it has a trailing /.
148 Defaults to `vm-folder-directory' if bound else to ~/MAIL/."
152 (defcustom mspools-vm-system-mail (or (getenv "MAIL")
153 (concat rmail-spool-directory
155 "*Spool file for main mailbox. Only used by VM.
156 This needs to be set to your primary mail spool - mspools will not run
157 without it. By default this will be set to the environment variable
158 $MAIL. Otherwise it will use `rmail-spool-directory' to guess where
159 your primary spool is. If this fails, set it to something like
160 /usr/spool/mail/login-name."
164 ;;; Internal Variables
166 (defvar mspools-files nil
167 "List of entries (SPOOL . SIZE) giving spool name and file size.")
169 (defvar mspools-files-len nil
170 "Length of `mspools-files' list.")
172 (defvar mspools-buffer "*spools*"
173 "Name of buffer for displaying spool info.")
175 (defvar mspools-mode-map
176 (let ((map (make-sparse-keymap)))
177 (define-key map "\C-c\C-c" 'mspools-visit-spool)
178 (define-key map "\C-m" 'mspools-visit-spool)
179 (define-key map " " 'mspools-visit-spool)
180 (define-key map "?" 'mspools-help)
181 (define-key map "q" 'mspools-quit)
182 (define-key map "n" 'next-line)
183 (define-key map "p" 'previous-line)
184 (define-key map "g" 'revert-buffer))
185 "Keymap for the *spools* buffer.")
191 ;; set up vm if not already loaded.
194 (if (and (not vm-init-file-loaded) (file-readable-p vm-init-file))
195 (load-file vm-init-file))
196 (if (not mspools-folder-directory)
197 (setq mspools-folder-directory vm-folder-directory))
200 (defun mspools-set-vm-spool-files ()
201 "Set value of `vm-spool-files'. Only needed for VM."
202 (if (not (file-readable-p mspools-vm-system-mail))
203 (error "Need to set mspools-vm-system-mail to the spool for primary inbox"))
204 (if (null mspools-folder-directory)
205 (error "Set `mspools-folder-directory' to where the spool files are"))
211 (list vm-primary-inbox
212 mspools-vm-system-mail ; your mailbox
213 vm-crash-box ;crash for mailbox
216 ;; Mailing list inboxes
217 ;; must have VM already loaded to get vm-folder-directory.
219 "make the appropriate entry for vm-spool-files"
221 (concat mspools-folder-directory s)
222 (concat mspools-folder-directory s "." mspools-suffix)
223 (concat mspools-folder-directory s ".crash")))
224 ;; So I create a vm-spool-files entry for each of those mail drops
225 (mapcar 'file-name-sans-extension
226 (directory-files mspools-folder-directory nil
227 (format "^[^.]+\\.%s" mspools-suffix)))
231 ;;; MSPOOLS-SHOW -- the main function
232 (defun mspools-show ( &optional noshow)
233 "Show the list of non-empty spool files in the *spools* buffer.
234 Buffer is not displayed if SHOW is non-nil."
236 (if (get-buffer mspools-buffer)
239 (set-buffer mspools-buffer)
240 (setq buffer-read-only nil)
241 (delete-region (point-min) (point-max)))
242 ;; else buffer doesn't exist so create it
243 (get-buffer-create mspools-buffer))
245 ;; generate the list of spool files
247 (mspools-set-vm-spool-files))
249 (mspools-get-spool-files)
250 (if (not noshow) (pop-to-buffer mspools-buffer))
252 (setq buffer-read-only t)
256 (declare-function rmail-get-new-mail "rmail" (&optional file-name))
259 (declare-function vm-visit-folder "ext:vm-startup" (folder &optional read-only))
261 (defun mspools-visit-spool ()
262 "Visit the folder on the current line of the *spools* buffer."
264 (let ( spool-name folder-name)
265 (setq spool-name (mspools-get-spool-name))
266 (if (null spool-name)
267 (message "No spool on current line")
269 (setq folder-name (mspools-get-folder-from-spool spool-name))
271 ;; put in a little "*" to indicate spool file has been read.
272 (if (not mspools-update)
274 (setq buffer-read-only nil)
278 (setq buffer-read-only t)
281 (message "folder %s spool %s" folder-name spool-name)
282 (if (eq (count-lines (point-min)
287 (forward-line (- 1 mspools-files-len)) ;back to top of list
288 ;; else just on to next line
291 ;; Choose whether to use VM or RMAIL for reading folder.
293 (vm-visit-folder (concat mspools-folder-directory folder-name))
295 (rmail (concat mspools-folder-directory folder-name))
296 (setq rmail-inbox-list
297 (list (concat mspools-folder-directory spool-name)))
298 (rmail-get-new-mail))
302 ;; generate new list of spools.
304 (mspools-show-again 'noshow))))))
306 (defun mspools-get-folder-from-spool (name)
307 "Return folder name corresponding to the spool file NAME."
308 ;; Simply strip of the extension.
309 (file-name-sans-extension name))
311 ;; Alternative version if you have more complicated mapping of spool name
313 ;(defun get-folder-from-spool-safe (name)
314 ; "Return the folder name corresponding to the spool file NAME."
315 ; (if (string-match "^\\(.*\\)\.spool$" name)
316 ; (substring name (match-beginning 1) (match-end 1))
317 ; (error "Could not extract folder name from spool name %s" name)))
320 ;(mspools-get-folder-from-spool "happy.spool")
321 ;(mspools-get-folder-from-spool "happy.sp")
323 (defun mspools-get-spool-name ()
324 "Return the name of the spool on the current line."
325 (let ((line-num (1- (count-lines (point-min)
330 (car (nth line-num mspools-files))))
332 ;;; Spools mode functions
334 (defun mspools-revert-buffer (ignore noconfirm)
335 "Re-run mspools-show to revert the *spools* buffer."
336 (mspools-show 'noshow))
338 (defun mspools-show-again (&optional noshow)
339 "Update the *spools* buffer. This is useful if mspools-update is
342 (mspools-show noshow))
344 (defun mspools-help ()
345 "Show help for `mspools-mode'."
347 (describe-function 'mspools-mode))
349 (defun mspools-quit ()
350 "Quit the *spools* buffer."
352 (kill-buffer mspools-buffer))
354 (defun mspools-mode ()
355 "Major mode for output from mspools-show.
356 \\<mspools-mode-map>Move point to one of the items in this buffer, then use
357 \\[mspools-visit-spool] to go to the spool that the current line refers to.
358 \\[revert-buffer] to regenerate the list of spools.
359 \\{mspools-mode-map}"
360 (kill-all-local-variables)
361 (make-local-variable 'revert-buffer-function)
362 (setq revert-buffer-function 'mspools-revert-buffer)
363 (use-local-map mspools-mode-map)
364 (setq major-mode 'mspools-mode)
365 (setq mode-name "MSpools")
366 (run-mode-hooks 'mspools-mode-hook))
368 (defun mspools-get-spool-files ()
369 "Find the list of spool files and display them in *spools* buffer."
370 (let (folders head spool len beg end any)
371 (if (null mspools-folder-directory)
372 (error "Set `mspools-folder-directory' to where the spool files are"))
373 (setq folders (directory-files mspools-folder-directory nil
374 (format "^[^.]+\\.%s$" mspools-suffix)))
375 (setq folders (mapcar 'mspools-size-folder folders))
376 (setq folders (delq nil folders))
377 (setq mspools-files folders)
378 (setq mspools-files-len (length mspools-files))
379 (set-buffer mspools-buffer)
382 (setq head (car folders))
383 (setq spool (car head))
384 (setq len (cdr head))
385 (setq folders (cdr folders))
387 (insert (format " %10d %s" len spool))
390 ;;(put-text-property beg end 'mouse-face 'highlight)
393 (delete-char -1)) ;delete last RET
394 (goto-char (point-min))
397 (defun mspools-size-folder (spool)
398 "Return (SPOOL . SIZE ), if SIZE of spool file is non-zero."
399 ;; 7th file attribute is the size of the file in bytes.
400 (let ((file (concat mspools-folder-directory spool))
402 (setq file (or (file-symlink-p file) file))
403 (setq size (nth 7 (file-attributes file)))
404 ;; size could be nil if the sym-link points to a non-existent file
405 ;; so check this first.
406 (if (and size (> size 0))
408 ;; else SPOOL is empty
413 ;; arch-tag: 8990b3ee-68c8-4892-98f1-51a735c8bac6
414 ;;; mspools.el ends here