Mercurial > emacs
view lisp/mail/mspools.el @ 18398:3c18aa006200
(LD_SWITCH_SYSTEM) [__mips__]: Alternate definition.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 23 Jun 1997 01:54:03 +0000 |
parents | 07602ad4416d |
children | 073e0019f9d9 |
line wrap: on
line source
;;; MSPOOLS.EL --- Show mail spools waiting to be read ;; Copyright (C) 1997 Stephen Eglen ;; Author: Stephen Eglen <stephene@cogs.susx.ac.uk> ;; Maintainer: Stephen Eglen <stephene@cogs.susx.ac.uk> ;; Created: 22 Jan 1997 ;; Version: 1.0 ;; Keywords: ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; If you use a mail filter (e.g. procmail, filter) to put mail messages in ;; folders, this file will let you see which folders have mail waiting ;; to be read in them. It assumes that new mail for the file `folder' ;; is written by the filter to a file called `folder.spool'. (If the ;; file writes directly to `folder' you may lose mail if new mail ;; arrives whilst you are reading the folder in emacs, hence the use ;; of a spool file.) For example, the following procmail recipe puts ;; any mail with `emacs' in the subject line into the spool file ;; `apple.spool', ready to go into the folder `emacs'. ;:0: ;* ^Subject.*emacs ;emacs.spool ;; It also assumes that all of your spool files and mail folders live ;; in the directory pointed to by `mspools-folder-directory', so you must ;; set this (see Installation). ;; When you run `mspools-show', it creates a *spools* buffer containing ;; all of the spools in the folder directory that are waiting to be ;; read. On each line is the spool name and its size in bytes. Move ;; to the line of the folder that you would like to read, and then ;; press return or space. The mailer (VM or RMAIL) should then read ;; that folder and get the new mail for you. When you return to the ;; *spools* buffer, you will either see "*" to indicate that the spool ;; has been read, or the remaining unread spools, depending on the ;; value of `mspools-update'. ;; This file should work with both VM and RMAIL. See the variable ;; `mspools-using-vm' for details. ;;; Installation ;; Basic ;(autoload 'mspools-show "mspools" "Show outstanding mail spools." t) ; Point to directory where spool files and folders are: ; (setq mspools-folder-directory "~/MAIL/") ;; Extras ; possibly bind it to a key: ;(global-set-key '[S-f1] 'mspools-show) ;(setq mspools-update t) ;; Interface with the mail filter ; We assume that the mail filter drops new mail into the spool ; `folder.spool'. If your spool files are something like folder.xyz ; for inbox `folder', then do ; (setq spool-suffix "xyz") ; If you use other conventions for your spool files, this code will ; need rewriting. ;;; Warning for VM users ;; Dont use if you are not sure what you are doing! The value of ;; vm-spool-files is altered, so you may not be able to read incoming ;; mail with VM if this is incorrectly set. ;; Useful settings for VM ;vm-auto-get-new-mail should be t (default t) ;;; Acknowledgements ;; The code for setting up vm-spool-files came from ;;http://www-users.informatik.rwth-aachen.de/~berg/archive/procmail/0047.html ;; Thanks to jond@mitre.org (Jonathan Doughty) ;;; TODO ;; What if users have mail spools in more than one directory? Extend ;; mspools-folder-directory to be a list of files? ;; I was going to add mouse support so that you could click on a line ;; to visit the buffer. Tell me if you want it, and I can put the ;; code in (I dont use the mouse much, so I havent bothered with it so ;; far). ;; Rather than showing size in bytes, could we see the number of msgs ;; waiting? (Could be more time demanding / system dependent). ;; Perl script counts the number of /^From / occurences. ;; ? ;; Include date ;; (substring (current-time-string (nth 4 (file-attributes "~/INBOX"))) 4 19) ;; Maybe just call a perl script to do all the hard work, and ;; visualise the results in the buffer. ;; Shrink wrap the buffer to remove excess white-space? ;;; User Variables (defvar mspools-update nil "*Non-nil means update *spools* buffer after visiting any folder.") (defvar mspools-suffix "spool" "*Extension used for spool files (not including full stop).") ;;; Internal Variables (defvar mspools-vm-system-mail (getenv "MAIL") "Main mailbox used. Only used by VM.") (defvar mspools-vm-system-mail-crash (concat mspools-vm-system-mail ".crash") "Crash box for main mailbox. See also `mspools-vm-system-mail'. Only used by VM." ) (defvar mspools-files nil "List of entries (SPOOL . SIZE) giving spool name and file size.") (defvar mspools-files-len nil "Length of `mspools-files' list.") (defvar mspools-buffer "*spools*" "Name of buffer for displaying spool info.") (defvar mspools-mode-map nil "Keymap for the *spools* buffer.") (defvar mspools-folder-directory (if (boundp 'vm-folder-directory) vm-folder-directory nil) "Directory where mail folders are kept. Defaults to `vm-folder-directory' if bound else nil. Make sure it has a trailing / at the end. ") (defvar mspools-using-vm (fboundp 'vm) "*Non-nil if VM is used as mail reader, otherwise RMAIL is used.") ;;; Code ;;; VM Specific code (if mspools-using-vm (require 'vm-vars)) (defun mspools-set-vm-spool-files () "Set value of `vm-spool-files'. Only needed for VM." (setq vm-spool-files (append (list ;; Main mailbox (list vm-primary-inbox mspools-vm-system-mail; your mailbox mspools-vm-system-mail-crash ; crash for mailbox )) ;; Mailing list inboxes (mapcar '(lambda (s) "make the appropriate entry for vm-spool-files" (list (concat vm-folder-directory s) (concat vm-folder-directory s "." mspools-suffix) (concat vm-folder-directory s ".crash"))) ;; So I create a vm-spool-files entry for each of those mail drops (mapcar 'file-name-sans-extension (directory-files vm-folder-directory nil (format "^[^.]+\\.%s" mspools-suffix))) )) )) ;;; MSPOOLS-SHOW -- the main function (defun mspools-show ( &optional noshow) "Show the list of non-empty spool files in the *spools* buffer. Buffer is not displayed if SHOW is non-nil." (interactive) (if (get-buffer mspools-buffer) ;; buffer exists (progn (set-buffer mspools-buffer) (setq buffer-read-only nil) (delete-region (point-min) (point-max))) ;; else buff. doesnt exist so create it (get-buffer-create mspools-buffer)) ;; generate the list of spool files (if mspools-using-vm (mspools-set-vm-spool-files)) (mspools-get-spool-files) (if (not noshow) (pop-to-buffer mspools-buffer)) (setq buffer-read-only t) (mspools-mode) ) (defun mspools-visit-spool () "Visit the folder on the current line of the *spools* buffer." (interactive) (let ( spool-name folder-name) (setq spool-name (mspools-get-spool-name)) (setq folder-name (mspools-get-folder-from-spool spool-name)) ;; put in a little "*" to indicate spool file has been read. (if (not mspools-update) (save-excursion (setq buffer-read-only nil) (beginning-of-line) (insert "*") (delete-char 1) (setq buffer-read-only t) )) (message "folder %s spool %s" folder-name spool-name) (if (eq (count-lines (point-min) (save-excursion (end-of-line) (point))) mspools-files-len) (next-line (- 1 mspools-files-len)) ;back to top of list ;; else just on to next line (next-line 1)) ;; Choose whether to use VM or RMAIL for reading folder. (if mspools-using-vm (vm-visit-folder (concat mspools-folder-directory folder-name)) ;; else using RMAIL (rmail (concat mspools-folder-directory folder-name)) (setq rmail-inbox-list (list (concat mspools-folder-directory spool-name))) (rmail-get-new-mail)) (if mspools-update ;; generate new list of spools. (save-excursion (mspools-show-again 'noshow))) )) (defun mspools-get-folder-from-spool (name) "Return folder name corresponding to the spool file NAME." ;; Simply strip of the extension. (file-name-sans-extension name)) ;; Alternative version if you have more complicated mapping of spool name ;; to file name. ;(defun get-folder-from-spool-safe (name) ; "Return the folder name corresponding to the spool file NAME." ; (if (string-match "^\\(.*\\)\.spool$" name) ; (substring name (match-beginning 1) (match-end 1)) ; (error "Could not extract folder name from spool name %s" name))) ; test ;(mspools-get-folder-from-spool "happy.spool") ;(mspools-get-folder-from-spool "happy.sp") (defun mspools-get-spool-name () "Return the name of the spool on the current line." (let ((line-num (1- (count-lines (point-min) (save-excursion (end-of-line) (point)) )))) (car (nth line-num mspools-files)))) ;;; Keymap (if mspools-mode-map () (setq mspools-mode-map (make-sparse-keymap)) (define-key mspools-mode-map "\C-c\C-c" 'mspools-visit-spool) (define-key mspools-mode-map "\C-m" 'mspools-visit-spool) (define-key mspools-mode-map " " 'mspools-visit-spool) (define-key mspools-mode-map "?" 'mspools-help) (define-key mspools-mode-map "q" 'mspools-quit) (define-key mspools-mode-map "g" 'revert-buffer)) ;;; Spools mode functions (defun mspools-revert-buffer (ignore noconfirm) "Re-run mspools-show to revert the *spools* buffer." (mspools-show 'noshow)) (defun mspools-show-again (&optional noshow) "Update the *spools* buffer. This is useful if mspools-update is nil." (interactive) (mspools-show noshow)) (defun mspools-help () "Show help for `mspools-mode'." (interactive) (describe-function 'mspools-mode)) (defun mspools-quit () "Quit the *spools* buffer." (interactive) (kill-buffer mspools-buffer)) (defun mspools-mode () "Major mode for output from mspools-show. \\<mspools-mode-map>Move point to one of the items in this buffer, then use \\[mspools-visit-spool] to go to the spool that the current line refers to. \\[mspools-show-again] to regenerate the list of spools. \\{mspools-mode-map}" (kill-all-local-variables) (make-local-variable 'revert-buffer-function) (setq revert-buffer-function 'mspools-revert-buffer) (use-local-map mspools-mode-map) (setq major-mode 'mspools-mode) (setq mode-name "MSpools") ) (defun mspools-get-spool-files () "Find the list of spool files and display them in *spools* buffer." (let (folders head spool len beg end any) (setq folders (directory-files mspools-folder-directory nil (format "^[^.]+\\.%s" mspools-suffix))) (setq folders (mapcar 'mspools-size-folder folders)) (setq folders (delq nil folders)) (setq mspools-files folders) (setq mspools-files-len (length mspools-files)) (set-buffer mspools-buffer) (while folders (setq any t) (setq head (car folders)) (setq spool (car head)) (setq len (cdr head)) (setq folders (cdr folders)) (setq beg (point)) (insert (format " %10d %s" len spool)) (setq end (point)) (insert "\n") ;;(put-text-property beg end 'mouse-face 'highlight) ) (if any (delete-char -1)) ;delete last RET (goto-char (point-min)) )) (defun mspools-size-folder (spool) "Return (SPOOL . SIZE ) iff SIZE of spool file is non-zero." ;; 7th file attribute is the size of the file in bytes. (let ((size (nth 7 (file-attributes (concat mspools-folder-directory spool))))) ;; todo (if (and (not (null size)) (> size 0)) (if (> size 0) (cons spool size) ;; else SPOOL is empty nil))) (provide 'mspools) ;;; MSPOOLS.EL ends here