*** empty log message ***
[emacs.git] / lisp / mail / mspools.el
blob8dc165dcc5e1e97ee83e2cd5f822372ff8c1276b
1 ;;; mspools.el --- show mail spools waiting to be read
3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
5 ;; Author: Stephen Eglen <stephen@gnu.org>
6 ;; Maintainer: Stephen Eglen <stephen@gnu.org>
7 ;; Created: 22 Jan 1997
8 ;; Keywords: mail
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)
16 ;; any later version.
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., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
28 ;;; Commentary:
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'.
39 ;:0:
40 ;* ^Subject.*emacs
41 ;emacs.spool
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.
67 ;; Extras.
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
78 ;; need rewriting.
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).
88 ;; Acknowledgements
89 ;; Thanks to jond@mitre.org (Jonathan Doughty) for help with code for
90 ;; setting up vm-spool-files.
92 ;;; TODO
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
102 ;; so far).
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?
111 ;;; Code:
113 ;;; User Variables
115 (defgroup mspools nil
116 "Show mail spools waiting to be read."
117 :group 'mail
118 :link '(emacs-commentary-link :tag "Commentary" "mspools.el")
121 (defcustom mspools-update nil
122 "*Non-nil means update *spools* buffer after visiting any folder."
123 :type 'boolean
124 :group 'mspools)
126 (defcustom mspools-suffix "spool"
127 "*Extension used for spool files (not including full stop)."
128 :type 'string
129 :group 'mspools)
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)
136 (defcustom mspools-folder-directory
137 (if (boundp 'vm-folder-directory)
138 vm-folder-directory
139 "~/MAIL/")
140 "*Directory where mail folders are kept. Ensure it has a trailing /.
141 Defaults to `vm-folder-directory' if bound else to ~/MAIL/."
142 :type 'directory
143 :group 'mspools)
145 (defcustom mspools-vm-system-mail (or (getenv "MAIL")
146 (concat rmail-spool-directory
147 (user-login-name)))
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
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."
154 :type 'file
155 :group 'mspools)
157 ;;; Internal Variables
159 (defvar mspools-files nil
160 "List of entries (SPOOL . SIZE) giving spool name and file size.")
162 (defvar mspools-files-len nil
163 "Length of `mspools-files' list.")
165 (defvar mspools-buffer "*spools*"
166 "Name of buffer for displaying spool info.")
168 (defvar mspools-mode-map nil
169 "Keymap for the *spools* buffer.")
171 ;;; Code
173 ;;; VM Specific code
174 (if mspools-using-vm
175 ;; set up vm if not already loaded.
176 (progn
177 (require 'vm-vars)
178 (if (and (not vm-init-file-loaded) (file-readable-p vm-init-file))
179 (load-file vm-init-file))
180 (if (not mspools-folder-directory)
181 (setq mspools-folder-directory vm-folder-directory))
184 (defun mspools-set-vm-spool-files ()
185 "Set value of `vm-spool-files'. Only needed for VM."
186 (if (not (file-readable-p mspools-vm-system-mail))
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
192 (append
193 (list
194 ;; Main mailbox
195 (list vm-primary-inbox
196 mspools-vm-system-mail ; your mailbox
197 vm-crash-box ;crash for mailbox
200 ;; Mailing list inboxes
201 ;; must have VM already loaded to get vm-folder-directory.
202 (mapcar '(lambda (s)
203 "make the appropriate entry for vm-spool-files"
204 (list
205 (concat mspools-folder-directory s)
206 (concat mspools-folder-directory s "." mspools-suffix)
207 (concat mspools-folder-directory s ".crash")))
208 ;; So I create a vm-spool-files entry for each of those mail drops
209 (mapcar 'file-name-sans-extension
210 (directory-files mspools-folder-directory nil
211 (format "^[^.]+\\.%s" mspools-suffix)))
215 ;;; MSPOOLS-SHOW -- the main function
216 (defun mspools-show ( &optional noshow)
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
223 (set-buffer mspools-buffer)
224 (setq buffer-read-only nil)
225 (delete-region (point-min) (point-max)))
226 ;; else buffer doesn't exist so create it
227 (get-buffer-create mspools-buffer))
229 ;; generate the list of spool files
230 (if mspools-using-vm
231 (mspools-set-vm-spool-files))
233 (mspools-get-spool-files)
234 (if (not noshow) (pop-to-buffer mspools-buffer))
236 (setq buffer-read-only t)
237 (mspools-mode)
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))
245 (if (null spool-name)
246 (message "No spool on current line")
248 (setq folder-name (mspools-get-folder-from-spool spool-name))
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)
260 (message "folder %s spool %s" folder-name spool-name)
261 (if (eq (count-lines (point-min)
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))
270 ;; Choose whether to use VM or RMAIL for reading folder.
271 (if mspools-using-vm
272 (vm-visit-folder (concat mspools-folder-directory folder-name))
273 ;; else using RMAIL
274 (rmail (concat mspools-folder-directory folder-name))
275 (setq rmail-inbox-list
276 (list (concat mspools-folder-directory spool-name)))
277 (rmail-get-new-mail))
280 (if mspools-update
281 ;; generate new list of spools.
282 (save-excursion
283 (mspools-show-again 'noshow))))))
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))
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)))
298 ; test
299 ;(mspools-get-folder-from-spool "happy.spool")
300 ;(mspools-get-folder-from-spool "happy.sp")
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))))
311 ;;; Keymap
313 (if mspools-mode-map
315 (setq mspools-mode-map (make-sparse-keymap))
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)
322 (define-key mspools-mode-map "n" 'next-line)
323 (define-key mspools-mode-map "p" 'previous-line)
324 (define-key mspools-mode-map "g" 'revert-buffer))
326 ;;; Spools mode functions
328 (defun mspools-revert-buffer (ignore noconfirm)
329 "Re-run mspools-show to revert the *spools* buffer."
330 (mspools-show 'noshow))
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))
338 (defun mspools-help ()
339 "Show help for `mspools-mode'."
340 (interactive)
341 (describe-function 'mspools-mode))
343 (defun mspools-quit ()
344 "Quit the *spools* buffer."
345 (interactive)
346 (kill-buffer mspools-buffer))
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.
352 \\[revert-buffer] to regenerate the list of spools.
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")
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)
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)))
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)
386 (if any
387 (delete-char -1)) ;delete last RET
388 (goto-char (point-min))
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.
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)))
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))
401 (cons spool size)
402 ;; else SPOOL is empty
403 nil)))
405 (provide 'mspools)
407 ;;; arch-tag: 8990b3ee-68c8-4892-98f1-51a735c8bac6
408 ;;; mspools.el ends here