view lisp/mail/mspools.el @ 110410:f2e111723c3a

Merge changes made in Gnus trunk. Reimplement nnimap, and do tweaks to the rest of the code to support that. * gnus-int.el (gnus-finish-retrieve-group-infos) (gnus-retrieve-group-data-early): New functions. * gnus-range.el (gnus-range-nconcat): New function. * gnus-start.el (gnus-get-unread-articles): Support early retrieval of data. (gnus-read-active-for-groups): Support finishing the early retrieval of data. * gnus-sum.el (gnus-summary-move-article): Pass the move-to group name if the move is internal, so that nnimap can do fast internal moves. * gnus.el (gnus-article-special-mark-lists): Add uid/active tuples, for nnimap usage. * nnimap.el: Rewritten. * nnmail.el (nnmail-inhibit-default-split-group): New internal variable to allow the mail splitting to not return a default group. This is useful for nnimap, which will leave unmatched mail in the inbox. * utf7.el (utf7-encode): Autoload. Implement shell connection. * nnimap.el (nnimap-open-shell-stream): New function. (nnimap-open-connection): Use it. Get the number of lines by using BODYSTRUCTURE. (nnimap-transform-headers): Get the number of lines in each message. (nnimap-retrieve-headers): Query for BODYSTRUCTURE so that we get the number of lines. Not all servers return UIDNEXT. Work past this problem. Remove junk from end of file. Fix typo in "bogus" section. Make capabilties be case-insensitive. Require cl when compiling. Don't bug out if the LIST command doesn't have any parameters. 2010-09-17 Knut Anders Hatlen <[e-mail]> (tiny change) * nnimap.el (nnimap-get-groups): Don't bug out if the LIST command doesn't have any parameters. (mm-text-html-renderer): Document gnus-article-html. 2010-09-17 Julien Danjou <[e-mail]> (tiny fix) * mm-decode.el (mm-text-html-renderer): Document gnus-article-html. * dgnushack.el: Define netrc-credentials. If the user doesn't have a /etc/services, supply some sensible port defaults. Have `unseen-or-unread' select an unread unseen article first. (nntp-open-server): Return whether the open was successful or not. Throughout all files, replace (save-excursion (set-buffer ...)) with (with-current-buffer ... ). Save result so that it doesn't say "failed" all the time. Add ~/.authinfo to the default, since that's probably most useful for users. Don't use the "finish" method when we're reading from the agent. Add some more nnimap-relevant agent stuff to nnagent.el. * nnimap.el (nnimap-with-process-buffer): Removed. Revert one line that was changed by mistake in the last checkin. (nnimap-open-connection): Don't error out when we can't make a connection nnimap-related changes to avoid bugging out if we can't contact a server. * gnus-start.el (gnus-get-unread-articles): Don't try to scan groups from methods that are denied. * nnimap.el (nnimap-possibly-change-group): Return nil if we can't log in. (nnimap-finish-retrieve-group-infos): Make sure we're not waiting for nothing. * gnus-sum.el (gnus-select-newsgroup): Indent.

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

;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005,
;;   2006, 2007, 2008, 2009, 2010 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 3 of the License, 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.  If not, see <http://www.gnu.org/licenses/>.

;;; 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
;; visualize the results in the buffer.

;; Shrink wrap the buffer to remove excess white-space?

;;; Code:

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

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

(declare-function rmail-get-new-mail "rmail" (&optional file-name))

;; External.
(declare-function vm-visit-folder "ext:vm-startup" (folder &optional read-only))

(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)
	  (forward-line (- 1 mspools-files-len)) ;back to top of list
	;; else just on to next line
	(forward-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")
  (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")
      ;;(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 ), if 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