1;;; mspools.el --- show mail spools waiting to be read
2
3;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005,
4;;   2006, 2007 Free Software Foundation, Inc.
5
6;; Author: Stephen Eglen <stephen@gnu.org>
7;; Maintainer: Stephen Eglen <stephen@gnu.org>
8;; Created: 22 Jan 1997
9;; Keywords: mail
10;; location: http://www.anc.ed.ac.uk/~stephen/emacs/
11
12;; This file is part of GNU Emacs.
13
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 2, or (at your option)
17;; any later version.
18
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.
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
26;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
27;; Boston, MA 02110-1301, USA.
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
39;; `emacs.spool', ready to go into the folder `emacs'.
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
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.
69;;
70;; (global-set-key '[S-f1] 'mspools-show) ;Bind mspools-show to Shift F1.
71;; (setq mspools-update t)                ;Automatically update buffer.
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
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
87;; vm-auto-get-new-mail should be t (the default).
88
89;; Acknowledgements
90;; Thanks to jond@mitre.org (Jonathan Doughty) for help with code for
91;; setting up vm-spool-files.
92
93;;; TODO
94
95;; What if users have mail spools in more than one directory?  Extend
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.
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
102;; code in (I don't use the mouse much, so I haven't bothered with it
103;; so far).
104
105;; Rather than showing size in bytes, could we see the number of msgs
106;; waiting?  (Could be more time demanding / system dependent).
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
112;;; Code:
113
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
122;;; User Variables
123
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)
139
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
145(defcustom mspools-folder-directory
146  (if (boundp 'vm-folder-directory)
147      vm-folder-directory
148    "~/MAIL/")
149  "*Directory where mail folders are kept.  Ensure it has a trailing /.
150Defaults to `vm-folder-directory' if bound else to ~/MAIL/."
151  :type 'directory
152  :group 'mspools)
153
154(defcustom mspools-vm-system-mail (or (getenv "MAIL")
155				      (concat rmail-spool-directory
156					      (user-login-name)))
157  "*Spool file for main mailbox.  Only used by VM.
158This needs to be set to your primary mail spool - mspools will not run
159without it.  By default this will be set to the environment variable
160$MAIL.  Otherwise it will use `rmail-spool-directory' to guess where
161your primary spool is.  If this fails, set it to something like
162/usr/spool/mail/login-name."
163  :type 'file
164  :group 'mspools)
165
166;;; Internal Variables
167
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
180;;; Code
181
182;;; VM Specific code
183(if mspools-using-vm
184    ;; set up vm if not already loaded.
185    (progn
186      (require 'vm-vars)
187      (if (and (not vm-init-file-loaded) (file-readable-p vm-init-file))
188	  (load-file vm-init-file))
189      (if (not mspools-folder-directory)
190	  (setq mspools-folder-directory vm-folder-directory))
191      ))
192
193(defun mspools-set-vm-spool-files ()
194  "Set value of `vm-spool-files'.  Only needed for VM."
195  (if (not (file-readable-p mspools-vm-system-mail))
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
201   (append
202    (list
203     ;; Main mailbox
204     (list vm-primary-inbox
205	   mspools-vm-system-mail	; your mailbox
206	   vm-crash-box			;crash for mailbox
207	   ))
208
209    ;; Mailing list inboxes
210    ;; must have VM already loaded to get vm-folder-directory.
211    (mapcar '(lambda (s)
212	       "make the appropriate entry for vm-spool-files"
213	       (list
214		(concat mspools-folder-directory s)
215		(concat mspools-folder-directory s "." mspools-suffix)
216		(concat mspools-folder-directory s ".crash")))
217	    ;; So I create a vm-spool-files entry for each of those mail drops
218	    (mapcar 'file-name-sans-extension
219		    (directory-files mspools-folder-directory nil
220				     (format "^[^.]+\\.%s" mspools-suffix)))
221	    ))
222   ))
223
224;;; MSPOOLS-SHOW -- the main function
225(defun mspools-show ( &optional noshow)
226  "Show the list of non-empty spool files in the *spools* buffer.
227Buffer is not displayed if SHOW is non-nil."
228  (interactive)
229  (if (get-buffer mspools-buffer)
230      ;; buffer exists
231      (progn
232	(set-buffer mspools-buffer)
233	(setq buffer-read-only nil)
234	(delete-region (point-min) (point-max)))
235    ;; else buffer doesn't exist so create it
236    (get-buffer-create mspools-buffer))
237
238  ;; generate the list of spool files
239  (if mspools-using-vm
240      (mspools-set-vm-spool-files))
241
242  (mspools-get-spool-files)
243  (if (not noshow) (pop-to-buffer mspools-buffer))
244
245  (setq buffer-read-only t)
246  (mspools-mode)
247  )
248
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))
254    (if (null spool-name)
255	(message "No spool on current line")
256
257      (setq folder-name (mspools-get-folder-from-spool spool-name))
258
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)
270      (if (eq (count-lines (point-min)
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))
278
279      ;; Choose whether to use VM or RMAIL for reading folder.
280      (if mspools-using-vm
281	  (vm-visit-folder (concat mspools-folder-directory folder-name))
282	;; else using RMAIL
283	(rmail (concat mspools-folder-directory folder-name))
284	(setq rmail-inbox-list
285	      (list (concat mspools-folder-directory spool-name)))
286	(rmail-get-new-mail))
287
288
289      (if mspools-update
290	  ;; generate new list of spools.
291	  (save-excursion
292	    (mspools-show-again 'noshow))))))
293
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
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))
325
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)
331  (define-key mspools-mode-map "n" 'next-line)
332  (define-key mspools-mode-map "p" 'previous-line)
333  (define-key mspools-mode-map "g" 'revert-buffer))
334
335;;; Spools mode functions
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
343nil."
344  (interactive)
345  (mspools-show noshow))
346
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))
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.
361\\[revert-buffer] to regenerate the list of spools.
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")
369  (run-mode-hooks 'mspools-mode-hook))
370
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)
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)))
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
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.
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)))
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))
410	(cons spool  size)
411      ;; else SPOOL is empty
412      nil)))
413
414(provide 'mspools)
415
416;;; arch-tag: 8990b3ee-68c8-4892-98f1-51a735c8bac6
417;;; mspools.el ends here
418