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