annotate lisp/mail/mspools.el @ 62412:6ac7ed8e212b

(makefile-dependency-regex): Turn it into a var, and refine it to mask one more level of nested vars. (makefile-rule-action-regex): Turn it into a var, and refine it so it recognizes backslashed continuation lines as belonging to the same command. (makefile-macroassign-regex): Refine it so it recognizes backslashed continuation lines as belonging to the same command. (makefile-var-use-regex): Don't look at the next char, because it might be the same one to be skipped by the initial [^$], leading to an overlooked variable use. (makefile-make-font-lock-keywords): Remove two parameters, which are now variables that some of the modes set locally. Handle dependency and rule action matching through functions, because regexps alone match too often. Dependency matching now comes last, so it can check, whether a colon already matched something else. (makefile-mode): Inform that font-lock improves makefile parsing capabilities. (makefile-match-dependency, makefile-match-action): New functions.

;;; mspools.el --- show mail spools waiting to be read

;; Copyright (C) 1997 Free Software Foundation, Inc.

;; Author: Stephen Eglen <[e-mail]>
;; Maintainer: Stephen Eglen <[e-mail]>
;; Created: 22 Jan 1997
;; Keywords: mail
;; location: http://www.anc.ed.ac.uk/~stephen/emacs/

;; This file is part of GNU Emacs.

;; GNU Emacs 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.

;; GNU Emacs 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
;; `emacs.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.

;;; Basic installation.
;; (autoload 'mspools-show "mspools" "Show outstanding mail spools." t)
;; (setq mspools-folder-directory "~/MAIL/")
;;
;; If you use VM, mspools-folder-directory will default to vm-folder-directory
;; unless you have already given it a value.

;; Extras.
;;
;; (global-set-key '[S-f1] 'mspools-show) ;Bind mspools-show to Shift F1.
;; (setq mspools-update t)                ;Automatically update buffer.

;; 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 mspools-suffix "xyz")
;; If you use other conventions for your spool files, this code will
;; need rewriting.

;; Warning for VM users
;; Don't 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 (the default).

;; Acknowledgements
;; Thanks to [e-mail] (Jonathan Doughty) for help with code for
;; setting up vm-spool-files.

;;; TODO

;; What if users have mail spools in more than one directory?  Extend
;; mspools-folder-directory to be a list of directories?  Currently,
;; if mail spools are in other directories, the way to read them is to
;; put a symbolic link to the spool into the mspools-folder-directory.

;; 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 don't use the mouse much, so I haven't 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).
;; 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?

;;; Code:

;;; User Variables

(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)

;;; Internal Variables

(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.")

;;; Code

;;; VM Specific code
(if mspools-using-vm
    ;; set up vm if not already loaded.
    (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
     ;; Main mailbox
     (list vm-primary-inbox
	   mspools-vm-system-mail	; your mailbox
	   vm-crash-box			;crash for mailbox
	   ))

    ;; Mailing list inboxes
    ;; must have VM already loaded to get vm-folder-directory.
    (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")))
	    ;; So I create a vm-spool-files entry for each of those mail drops
	    (mapcar 'file-name-sans-extension
		    (directory-files mspools-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 buffer doesn't 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))
    (if (null spool-name)
	(message "No spool on current line")

      (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 "n" 'next-line)
  (define-key mspools-mode-map "p" 'previous-line)
  (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.
\\[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")
  )

(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")
      ;;(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 ((file (concat mspools-folder-directory spool))
	size)
    (setq file (or (file-symlink-p file) file))
    (setq size (nth 7 (file-attributes file)))
    ;; size could be nil if the sym-link points to a non-existent file
    ;; so check this first.
    (if (and size  (> size 0))
	(cons spool  size)
      ;; else SPOOL is empty
      nil)))

(provide 'mspools)

;;; arch-tag: 8990b3ee-68c8-4892-98f1-51a735c8bac6
;;; mspools.el ends here