Commit | Line | Data |
---|---|---|
e8af40ee | 1 | ;;; mspools.el --- show mail spools waiting to be read |
178fc2d3 | 2 | |
f2e3589a | 3 | ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, |
5df4f04c | 4 | ;; 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. |
178fc2d3 | 5 | |
b2537dfa RS |
6 | ;; Author: Stephen Eglen <stephen@gnu.org> |
7 | ;; Maintainer: Stephen Eglen <stephen@gnu.org> | |
178fc2d3 | 8 | ;; Created: 22 Jan 1997 |
835b892a | 9 | ;; Keywords: mail |
183040ff | 10 | ;; location: http://www.anc.ed.ac.uk/~stephen/emacs/ |
178fc2d3 | 11 | |
a815b83c RS |
12 | ;; This file is part of GNU Emacs. |
13 | ||
b1fc2b50 | 14 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
178fc2d3 | 15 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
16 | ;; the Free Software Foundation, either version 3 of the License, or |
17 | ;; (at your option) any later version. | |
178fc2d3 | 18 | |
a815b83c | 19 | ;; GNU Emacs is distributed in the hope that it will be useful, |
178fc2d3 RS |
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 | |
b1fc2b50 | 25 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
178fc2d3 RS |
26 | |
27 | ;;; Commentary: | |
28 | ||
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 | |
84b7ccbd | 37 | ;; `emacs.spool', ready to go into the folder `emacs'. |
178fc2d3 RS |
38 | ;:0: |
39 | ;* ^Subject.*emacs | |
40 | ;emacs.spool | |
41 | ||
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). | |
45 | ||
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'. | |
55 | ||
56 | ;; This file should work with both VM and RMAIL. See the variable | |
57 | ;; `mspools-using-vm' for details. | |
58 | ||
3fb11d36 SE |
59 | ;;; Basic installation. |
60 | ;; (autoload 'mspools-show "mspools" "Show outstanding mail spools." t) | |
61 | ;; (setq mspools-folder-directory "~/MAIL/") | |
62 | ;; | |
63 | ;; If you use VM, mspools-folder-directory will default to vm-folder-directory | |
64 | ;; unless you have already given it a value. | |
65 | ||
66 | ;; Extras. | |
8b776ea8 | 67 | ;; |
3fb11d36 | 68 | ;; (global-set-key '[S-f1] 'mspools-show) ;Bind mspools-show to Shift F1. |
8b776ea8 | 69 | ;; (setq mspools-update t) ;Automatically update buffer. |
3fb11d36 SE |
70 | |
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 | |
77 | ;; need rewriting. | |
78 | ||
79 | ;; Warning for VM users | |
80 | ;; Don't use if you are not sure what you are doing. The value of | |
178fc2d3 RS |
81 | ;; vm-spool-files is altered, so you may not be able to read incoming |
82 | ;; mail with VM if this is incorrectly set. | |
83 | ||
84 | ;; Useful settings for VM | |
3fb11d36 | 85 | ;; vm-auto-get-new-mail should be t (the default). |
178fc2d3 | 86 | |
3fb11d36 SE |
87 | ;; Acknowledgements |
88 | ;; Thanks to jond@mitre.org (Jonathan Doughty) for help with code for | |
89 | ;; setting up vm-spool-files. | |
178fc2d3 RS |
90 | |
91 | ;;; TODO | |
92 | ||
93 | ;; What if users have mail spools in more than one directory? Extend | |
3fb11d36 SE |
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. | |
178fc2d3 RS |
97 | |
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 | |
3fb11d36 SE |
100 | ;; code in (I don't use the mouse much, so I haven't bothered with it |
101 | ;; so far). | |
178fc2d3 RS |
102 | |
103 | ;; Rather than showing size in bytes, could we see the number of msgs | |
104 | ;; waiting? (Could be more time demanding / system dependent). | |
178fc2d3 | 105 | ;; Maybe just call a perl script to do all the hard work, and |
fffa137c | 106 | ;; visualize the results in the buffer. |
178fc2d3 RS |
107 | |
108 | ;; Shrink wrap the buffer to remove excess white-space? | |
109 | ||
3fb11d36 | 110 | ;;; Code: |
178fc2d3 | 111 | |
4521e9ad JB |
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) | |
119 | ||
178fc2d3 RS |
120 | ;;; User Variables |
121 | ||
3fb11d36 SE |
122 | (defgroup mspools nil |
123 | "Show mail spools waiting to be read." | |
124 | :group 'mail | |
125 | :link '(emacs-commentary-link :tag "Commentary" "mspools.el") | |
126 | ) | |
127 | ||
128 | (defcustom mspools-update nil | |
129 | "*Non-nil means update *spools* buffer after visiting any folder." | |
130 | :type 'boolean | |
131 | :group 'mspools) | |
132 | ||
133 | (defcustom mspools-suffix "spool" | |
134 | "*Extension used for spool files (not including full stop)." | |
135 | :type 'string | |
136 | :group 'mspools) | |
178fc2d3 | 137 | |
3fb11d36 SE |
138 | (defcustom mspools-using-vm (fboundp 'vm) |
139 | "*Non-nil if VM is used as mail reader, otherwise RMAIL is used." | |
140 | :type 'boolean | |
141 | :group 'mspools) | |
142 | ||
3fb11d36 SE |
143 | (defcustom mspools-folder-directory |
144 | (if (boundp 'vm-folder-directory) | |
145 | vm-folder-directory | |
8b776ea8 | 146 | "~/MAIL/") |
3fb11d36 | 147 | "*Directory where mail folders are kept. Ensure it has a trailing /. |
8b776ea8 | 148 | Defaults to `vm-folder-directory' if bound else to ~/MAIL/." |
3fb11d36 SE |
149 | :type 'directory |
150 | :group 'mspools) | |
178fc2d3 | 151 | |
fd202b85 SE |
152 | (defcustom mspools-vm-system-mail (or (getenv "MAIL") |
153 | (concat rmail-spool-directory | |
154 | (user-login-name))) | |
8b776ea8 SE |
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 | |
fd202b85 SE |
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." | |
8b776ea8 SE |
161 | :type 'file |
162 | :group 'mspools) | |
178fc2d3 | 163 | |
8b776ea8 | 164 | ;;; Internal Variables |
178fc2d3 | 165 | |
178fc2d3 RS |
166 | (defvar mspools-files nil |
167 | "List of entries (SPOOL . SIZE) giving spool name and file size.") | |
168 | ||
169 | (defvar mspools-files-len nil | |
170 | "Length of `mspools-files' list.") | |
171 | ||
172 | (defvar mspools-buffer "*spools*" | |
173 | "Name of buffer for displaying spool info.") | |
174 | ||
a0310a6c DN |
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) | |
a11de514 R |
184 | (define-key map "g" 'revert-buffer) |
185 | map) | |
178fc2d3 RS |
186 | "Keymap for the *spools* buffer.") |
187 | ||
178fc2d3 RS |
188 | ;;; Code |
189 | ||
190 | ;;; VM Specific code | |
191 | (if mspools-using-vm | |
84b7ccbd RS |
192 | ;; set up vm if not already loaded. |
193 | (progn | |
194 | (require 'vm-vars) | |
8b776ea8 | 195 | (if (and (not vm-init-file-loaded) (file-readable-p vm-init-file)) |
84b7ccbd RS |
196 | (load-file vm-init-file)) |
197 | (if (not mspools-folder-directory) | |
198 | (setq mspools-folder-directory vm-folder-directory)) | |
199 | )) | |
178fc2d3 RS |
200 | |
201 | (defun mspools-set-vm-spool-files () | |
202 | "Set value of `vm-spool-files'. Only needed for VM." | |
fd202b85 | 203 | (if (not (file-readable-p mspools-vm-system-mail)) |
8b776ea8 SE |
204 | (error "Need to set mspools-vm-system-mail to the spool for primary inbox")) |
205 | (if (null mspools-folder-directory) | |
206 | (error "Set `mspools-folder-directory' to where the spool files are")) | |
207 | (setq | |
208 | vm-spool-files | |
178fc2d3 RS |
209 | (append |
210 | (list | |
211 | ;; Main mailbox | |
212 | (list vm-primary-inbox | |
8b776ea8 SE |
213 | mspools-vm-system-mail ; your mailbox |
214 | vm-crash-box ;crash for mailbox | |
178fc2d3 | 215 | )) |
a1506d29 | 216 | |
178fc2d3 | 217 | ;; Mailing list inboxes |
84b7ccbd | 218 | ;; must have VM already loaded to get vm-folder-directory. |
178fc2d3 RS |
219 | (mapcar '(lambda (s) |
220 | "make the appropriate entry for vm-spool-files" | |
221 | (list | |
8b776ea8 SE |
222 | (concat mspools-folder-directory s) |
223 | (concat mspools-folder-directory s "." mspools-suffix) | |
224 | (concat mspools-folder-directory s ".crash"))) | |
178fc2d3 | 225 | ;; So I create a vm-spool-files entry for each of those mail drops |
a1506d29 JB |
226 | (mapcar 'file-name-sans-extension |
227 | (directory-files mspools-folder-directory nil | |
178fc2d3 RS |
228 | (format "^[^.]+\\.%s" mspools-suffix))) |
229 | )) | |
230 | )) | |
231 | ||
178fc2d3 | 232 | ;;; MSPOOLS-SHOW -- the main function |
8b776ea8 | 233 | (defun mspools-show ( &optional noshow) |
178fc2d3 RS |
234 | "Show the list of non-empty spool files in the *spools* buffer. |
235 | Buffer is not displayed if SHOW is non-nil." | |
236 | (interactive) | |
237 | (if (get-buffer mspools-buffer) | |
238 | ;; buffer exists | |
239 | (progn | |
8b776ea8 SE |
240 | (set-buffer mspools-buffer) |
241 | (setq buffer-read-only nil) | |
178fc2d3 | 242 | (delete-region (point-min) (point-max))) |
3fb11d36 | 243 | ;; else buffer doesn't exist so create it |
178fc2d3 | 244 | (get-buffer-create mspools-buffer)) |
a1506d29 | 245 | |
178fc2d3 RS |
246 | ;; generate the list of spool files |
247 | (if mspools-using-vm | |
248 | (mspools-set-vm-spool-files)) | |
a1506d29 | 249 | |
178fc2d3 RS |
250 | (mspools-get-spool-files) |
251 | (if (not noshow) (pop-to-buffer mspools-buffer)) | |
a1506d29 | 252 | |
178fc2d3 RS |
253 | (setq buffer-read-only t) |
254 | (mspools-mode) | |
255 | ) | |
256 | ||
2b54af74 DN |
257 | (declare-function rmail-get-new-mail "rmail" (&optional file-name)) |
258 | ||
5d91f66b GM |
259 | ;; External. |
260 | (declare-function vm-visit-folder "ext:vm-startup" (folder &optional read-only)) | |
261 | ||
178fc2d3 RS |
262 | (defun mspools-visit-spool () |
263 | "Visit the folder on the current line of the *spools* buffer." | |
264 | (interactive) | |
265 | (let ( spool-name folder-name) | |
266 | (setq spool-name (mspools-get-spool-name)) | |
3fb11d36 SE |
267 | (if (null spool-name) |
268 | (message "No spool on current line") | |
a1506d29 | 269 | |
3fb11d36 | 270 | (setq folder-name (mspools-get-folder-from-spool spool-name)) |
a1506d29 | 271 | |
3fb11d36 SE |
272 | ;; put in a little "*" to indicate spool file has been read. |
273 | (if (not mspools-update) | |
274 | (save-excursion | |
275 | (setq buffer-read-only nil) | |
276 | (beginning-of-line) | |
277 | (insert "*") | |
278 | (delete-char 1) | |
279 | (setq buffer-read-only t) | |
280 | )) | |
281 | ||
282 | (message "folder %s spool %s" folder-name spool-name) | |
9b026d9f | 283 | (if (eq (count-lines (point-min) (point-at-eol)) |
3fb11d36 | 284 | mspools-files-len) |
97546017 | 285 | (forward-line (- 1 mspools-files-len)) ;back to top of list |
3fb11d36 | 286 | ;; else just on to next line |
97546017 | 287 | (forward-line 1)) |
a1506d29 | 288 | |
3fb11d36 | 289 | ;; Choose whether to use VM or RMAIL for reading folder. |
8b776ea8 | 290 | (if mspools-using-vm |
3fb11d36 | 291 | (vm-visit-folder (concat mspools-folder-directory folder-name)) |
8b776ea8 | 292 | ;; else using RMAIL |
3fb11d36 | 293 | (rmail (concat mspools-folder-directory folder-name)) |
8b776ea8 | 294 | (setq rmail-inbox-list |
3fb11d36 SE |
295 | (list (concat mspools-folder-directory spool-name))) |
296 | (rmail-get-new-mail)) | |
a1506d29 JB |
297 | |
298 | ||
3fb11d36 SE |
299 | (if mspools-update |
300 | ;; generate new list of spools. | |
8b776ea8 | 301 | (save-excursion |
3fb11d36 | 302 | (mspools-show-again 'noshow)))))) |
178fc2d3 | 303 | |
178fc2d3 RS |
304 | (defun mspools-get-folder-from-spool (name) |
305 | "Return folder name corresponding to the spool file NAME." | |
306 | ;; Simply strip of the extension. | |
307 | (file-name-sans-extension name)) | |
308 | ||
309 | ;; Alternative version if you have more complicated mapping of spool name | |
310 | ;; to file name. | |
311 | ;(defun get-folder-from-spool-safe (name) | |
312 | ; "Return the folder name corresponding to the spool file NAME." | |
313 | ; (if (string-match "^\\(.*\\)\.spool$" name) | |
314 | ; (substring name (match-beginning 1) (match-end 1)) | |
315 | ; (error "Could not extract folder name from spool name %s" name))) | |
316 | ||
317 | ; test | |
318 | ;(mspools-get-folder-from-spool "happy.spool") | |
319 | ;(mspools-get-folder-from-spool "happy.sp") | |
320 | ||
178fc2d3 RS |
321 | (defun mspools-get-spool-name () |
322 | "Return the name of the spool on the current line." | |
9b026d9f | 323 | (let ((line-num (1- (count-lines (point-min) (point-at-eol))))) |
178fc2d3 RS |
324 | (car (nth line-num mspools-files)))) |
325 | ||
8b776ea8 | 326 | ;;; Spools mode functions |
178fc2d3 RS |
327 | |
328 | (defun mspools-revert-buffer (ignore noconfirm) | |
329 | "Re-run mspools-show to revert the *spools* buffer." | |
330 | (mspools-show 'noshow)) | |
331 | ||
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)) | |
a1506d29 | 337 | |
178fc2d3 RS |
338 | (defun mspools-help () |
339 | "Show help for `mspools-mode'." | |
340 | (interactive) | |
341 | (describe-function 'mspools-mode)) | |
342 | ||
343 | (defun mspools-quit () | |
344 | "Quit the *spools* buffer." | |
345 | (interactive) | |
346 | (kill-buffer mspools-buffer)) | |
178fc2d3 RS |
347 | |
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. | |
84b7ccbd | 352 | \\[revert-buffer] to regenerate the list of spools. |
178fc2d3 RS |
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") | |
a946a4b4 | 360 | (run-mode-hooks 'mspools-mode-hook)) |
178fc2d3 | 361 | |
178fc2d3 RS |
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) | |
8b776ea8 SE |
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))) | |
178fc2d3 RS |
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) | |
385 | ) | |
386 | (if any | |
387 | (delete-char -1)) ;delete last RET | |
388 | (goto-char (point-min)) | |
389 | )) | |
390 | ||
178fc2d3 | 391 | (defun mspools-size-folder (spool) |
81bb49ce | 392 | "Return (SPOOL . SIZE ), if SIZE of spool file is non-zero." |
178fc2d3 | 393 | ;; 7th file attribute is the size of the file in bytes. |
84b7ccbd RS |
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))) | |
3fb11d36 SE |
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)) | |
178fc2d3 RS |
401 | (cons spool size) |
402 | ;; else SPOOL is empty | |
403 | nil))) | |
404 | ||
405 | (provide 'mspools) | |
84b7ccbd | 406 | |
e8af40ee | 407 | ;;; mspools.el ends here |