(defvar rmail-inbox-list)
(defvar vm-crash-box)
(defvar vm-folder-directory)
(defvar vm-init-file)
(defvar vm-init-file-loaded)
(defvar vm-primary-inbox)
(defvar vm-spool-files)
(defgroup mspools nil
"Show mail spools waiting to be read."
:group 'mail
:link '(emacs-commentary-link :tag "Commentary" "mspools.el")
)
(defcustom mspools-update nil
"*Non-nil means update *spools* buffer after visiting any folder."
:type 'boolean
:group 'mspools)
(defcustom mspools-suffix "spool"
"*Extension used for spool files (not including full stop)."
:type 'string
:group 'mspools)
(defcustom mspools-using-vm (fboundp 'vm)
"*Non-nil if VM is used as mail reader, otherwise RMAIL is used."
:type 'boolean
:group 'mspools)
(defcustom mspools-folder-directory
(if (boundp 'vm-folder-directory)
vm-folder-directory
"~/MAIL/")
"*Directory where mail folders are kept. Ensure it has a trailing /.
Defaults to `vm-folder-directory' if bound else to ~/MAIL/."
:type 'directory
:group 'mspools)
(defcustom mspools-vm-system-mail (or (getenv "MAIL")
(concat rmail-spool-directory
(user-login-name)))
"*Spool file for main mailbox. Only used by VM.
This needs to be set to your primary mail spool - mspools will not run
without it. By default this will be set to the environment variable
$MAIL. Otherwise it will use `rmail-spool-directory' to guess where
your primary spool is. If this fails, set it to something like
/usr/spool/mail/login-name."
:type 'file
:group 'mspools)
(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.")
(if mspools-using-vm
(progn
(require 'vm-vars)
(if (and (not vm-init-file-loaded) (file-readable-p vm-init-file))
(load-file vm-init-file))
(if (not mspools-folder-directory)
(setq mspools-folder-directory vm-folder-directory))
))
(defun mspools-set-vm-spool-files ()
"Set value of `vm-spool-files'. Only needed for VM."
(if (not (file-readable-p mspools-vm-system-mail))
(error "Need to set mspools-vm-system-mail to the spool for primary inbox"))
(if (null mspools-folder-directory)
(error "Set `mspools-folder-directory' to where the spool files are"))
(setq
vm-spool-files
(append
(list
(list vm-primary-inbox
mspools-vm-system-mail vm-crash-box ))
(mapcar '(lambda (s)
"make the appropriate entry for vm-spool-files"
(list
(concat mspools-folder-directory s)
(concat mspools-folder-directory s "." mspools-suffix)
(concat mspools-folder-directory s ".crash")))
(mapcar 'file-name-sans-extension
(directory-files mspools-folder-directory nil
(format "^[^.]+\\.%s" mspools-suffix)))
))
))
(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)
(progn
(set-buffer mspools-buffer)
(setq buffer-read-only nil)
(delete-region (point-min) (point-max)))
(get-buffer-create mspools-buffer))
(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))
(if (null spool-name)
(message "No spool on current line")
(setq folder-name (mspools-get-folder-from-spool spool-name))
(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)) (next-line 1))
(if mspools-using-vm
(vm-visit-folder (concat mspools-folder-directory folder-name))
(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
(save-excursion
(mspools-show-again 'noshow))))))
(defun mspools-get-folder-from-spool (name)
"Return folder name corresponding to the spool file NAME."
(file-name-sans-extension name))
(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))))
(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 "n" 'next-line)
(define-key mspools-mode-map "p" 'previous-line)
(define-key mspools-mode-map "g" 'revert-buffer))
(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.
\\[revert-buffer] 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")
(run-mode-hooks 'mspools-mode-hook))
(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)
(if (null mspools-folder-directory)
(error "Set `mspools-folder-directory' to where the spool files are"))
(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")
)
(if any
(delete-char -1)) (goto-char (point-min))
))
(defun mspools-size-folder (spool)
"Return (SPOOL . SIZE ) iff SIZE of spool file is non-zero."
(let ((file (concat mspools-folder-directory spool))
size)
(setq file (or (file-symlink-p file) file))
(setq size (nth 7 (file-attributes file)))
(if (and size (> size 0))
(cons spool size)
nil)))
(provide 'mspools)