;;; epop3mail.el --- retrieve mail using epop3.el ("extended" pop3.el) ;; ;; Author: Franklin Lee ;; Created: 11/1997 ;; Keywords: mail pop3 ;; Version: 0.9.7 ;; ;; Copyright (C) 1997, 1998 Franklin Lee ;; ;; 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. ;; ;; epop3mail.el 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, 675 Mass Ave, Cambridge, MA 02139, USA. ;; ;;; Commentary: ;;; {{{ ;; ;; Description ;; ----------- ;; ;; 'epop3mail' stands for 'extended pop3 mail'. It uses 'pop3.el' as ;; distributed in Gnus v 5.4.65, with a bugfix patch (described below). ;; 'pop3.el' provides emacs-lisp primitives to handle a connection between ;; emacs and a pop3 server. Also used is 'epop3.el' ("extended pop3.el"), ;; which calls on and extends the functionality of pop3.el (namely, the ;; UIDL and LIST commands in the POP3 protocol, which are not in pop3.el). ;; ;; epop3mail should be used when one gets mail from a pop3 server and ;; wishes to *leave mail on server* rather than use the default movemail ;; functionality. Sometimes the default functionality is undesirable ;; (i.e., taking the mail down to the local machine and then deleting it ;; from the server) when, for example, one is retrieving mail using a ;; laptop on the road or from home. In such a circumstance, it would be ;; nice to get mail from the POP3 server but also leave it there so that ;; it can be accessed when one returns to work (or retrieves from another ;; machine). ;; ;; epop3mail.el supports 'leave-mail-on-server' (the default), and also ;; supports multiple pop3 mailboxes. Passwords and authentication schemes ;; are cached (per mailbox) by default, so you only need to enter them ;; once (the first time) during an emacs session. ;; ;; Note: an enterprising Gnus user () has ;; tested and helped with the Gnus-compatibility. For those wanting to ;; use this with Gnus, ignore the references to 'rmail' and note ;; references to Gnus below. ;; ;; -------------------------------------------------------------------------- ;; ;; The discussion below assumes that 'epop3-leave-mail-on-server' is set ;; to 't'. If set to 'nil', 'normal' rmail behavior (i.e., delete mail ;; from server) is maintained. This is for backward compatibility for ;; those who don't want or need leave-mail-on-server but would like to ;; have the biff feature, or have APOP authentication, or just dislike ;; movemail on principle and want a wholly elisp solution. (Take your ;; pick). ;; ;; When called from rmail, epop3mail first tries to get the UIDL from the ;; POP3 server and saves that information for later retrievals. Caching ;; the UIDL data (in ~/.uidls.*) allows epop3mail to retrieve only those ;; messages which have _not_ been previously retrieved. Without this ;; information, all messages left on the server are gotten -- which is of ;; course undesirable! (UIDs (Unique IDs) are cached on a per-mailbox ;; basis by epop3mail, so if you have several pop3 mailboxes, you will ;; have that many ~/.uidls.* files). If epop3mail finds that UIDL is not ;; supported by the POP3 server, it will default to retrieving all ;; messages. (This is unfortunate, but there's no simple recourse in this ;; situation). ;; ;; epop3mail does all of this by overriding rmail.el's function ;; 'rmail-insert-inbox-text' to use the emacs lisp code rather than use ;; movemail for pop3 mail. Since this function may be different between ;; versions of emacs, you may have to modify epop3mail's version of ;; rmail-insert-inbox-text to match your version of rmail. (see the code ;; marked 'pop3-mail change' for the cond-clause which does the actual ;; override). ;; ;; Usage ;; ----- ;; To use epop3mail, do the following: ;; ;; (0) Put the files pop3.el, epop3.el, epop3hash.el, biff-mode.el, and ;; epop3mail in your load-path, preferably byte-compiled. You may need to ;; explicitly (load-library "cl") in order to successfully compile ;; epop3mail and epop3hash. ;; ;; If you have Gnus' pop3.el already, apply the following patch to your ;; version (this bug patch has been reported to the author). This fixes a ;; minor problem with setting 'pop3-read-point' for subsequent parsing of ;; data returning from the pop3 server, and properly places this setting ;; inside of a (save-excursion). Without this patch, epop3mail will ;; occasionally attempt to parse the wrong buffer, and hang. ;; ;; -----------------------------8<---- cut here ----8<----------------------- ;; *** pop3.el Mon Nov 24 21:13:48 1997 ;; --- pop3.orig.el Sat Jul 19 16:39:26 1997 ;; *************** ;; *** 108,117 **** ;; (process)) ;; (save-excursion ;; (set-buffer process-buffer) ;; ! (erase-buffer) ;; ! (setq pop3-read-point (point-min))) ;; (setq process ;; (open-network-stream "POP" process-buffer mailhost port)) ;; (let ((response (pop3-read-response process t))) ;; (setq pop3-timestamp ;; already (substring response (or (string-match "<" response) 0) ;; --- 108,117 ---- ;; (process)) ;; (save-excursion ;; (set-buffer process-buffer) ;; ! (erase-buffer)) ;; (setq process ;; (open-network-stream "POP" process-buffer mailhost port)) ;; + (setq pop3-read-point (point-min)) ;; (let ((response (pop3-read-response process t))) ;; (setq pop3-timestamp ;; (substring response (or (string-match "<" response) 0) ;; -----------------------------8<---- cut here ----8<----------------------- ;; ;; (1) Specify the pop mailbox(es). ;; ;; Method (a) (the preferred method): add "po:user@server" to ;; 'rmail-primary-inbox-list (be sure to specify both user *and* fully ;; qualified hostname in the form user@fully-qualified-host) like this: ;; ;; (setq rmail-primary-inbox-list ;; '("po:me@mypopserver.domain.com" ;; "po:m3@anotherserver.elsewhere.com" ;; . . . )) ;; ;; This is the most flexible method. IMPORTANT: Make sure that the '@' ;; and server.domain are included; the presence of the '@' character is ;; what causes this code to be called instead of movemail. ;; ;; Setting MAILHOST won't help here because only movemail uses the ;; MAILHOST environment variable and the purpose of epop3mail is to ;; *avoid* using an external movemail program. ;; ;; IMPORTANT: if you wish to use the 'biffing' features provided by ;; epop3mail, you *must* use method (a) above to specify your pop ;; mailboxes; otherwise the biff code won't know where to look for your ;; mailbox specifications. ;; ;; ;; Method (b): Alternatively, you can add a 'Mail:' line to the top of ;; your RMAIL file (make sure it's comma-delimited) like this: ;; ;; BABYL OPTIONS: -*- rmail -*- ;; Version: 5 ;; Labels: ;; Mail: po:me@mypopserver.domain.com, po:m3@anotherserver.elsewhere.com ;; Note: This is the header of an rmail file. ;; Note: If you are seeing it in rmail, ;; Note: it means the file has no messages in it. ;; ;; Method (b) will override method (a). The same note about including '@' ;; and server/domain applies here. ;; ;; If you use method (b), you won't be able to use the 'biff' feature. ;; (maybe a future version of epop3mail / epop3-biff will be smarter about ;; this, but at the moment it's simpler to reference ;; 'rmail-primary-inbox-list'). ;; ;; (2) Insure sure RMAIL doesn't use movemail for your pop mailboxes. ;; (see the override function 'rmail-insert-inbox-text' below for the ;; additional code calling 'epop3-mail' -- the mailbox name set in (1) ;; above *must* have the '@' in it to avoid using movemail. ;; ;; ALSO: if you have the following in your initialization code: ;; ;; (setq rmail-pop-password-required t) ;; ;; take it out or comment it out. It won't be needed; epop3mail uses ;; its own password caching (per mailbox). Leaving it in will cause ;; rmail to ask you for the password in addition to epop3mail asking; ;; I don't know if rmail will remember it, but epop3mail will, by default. ;; ;; ;; Then add to your emacs (depending on version): ;; ;; emacs v 19.34 users: ;; (add-hook 'rmail-mode-hook (function (lambda () (require 'epop3mail)))) ;; ;; emacs v 20.2+ users: ;; (require 'epop3mail) ;; ;; The difference above is due to rmail having changed its initialization ;; sequence between v 19.34 and v 20.2. Note that epop3mail does a ;; (require 'rmail) if needed, so v 20.2 users need only put the above ;; line in. ;; ;; ;; Gnus users: ;; (setq epop3-mail-package 'gnus ;; nnmail-movemail-program 'epop3-mail ;; nnmail-spool-file "po:user@popserver" ;; nnmail-pop-password-required nil) ;; ;; The internal (require 'rmail) is ignored by epop3mail if the above setq ;; is performed. ;; ;; ------------------------------------------- ;; [11/03/1998: commentary by jvinson@chevax.ecs.umass.edu ;; ;; I was looking through the comments at the top of the epop3mail file and ;; noticed a little something that needs to be changed. Gnus users do not ;; need to set nnmail-movemail-program and nnmail-pop-password-required AS ;; LONG AS epop3mail gets loaded before gnus tries to get mail. Basically, ;; this means that the setq should be followed by a (require 'epop3mail). ;; ;; I get this to happen by running (start-biff) which is on an autoload. ;; ;; If people prefer to have things load by auto-load, then they need to set ;; the nnmail-movemail-program by hand. ;; ------------------------------------------- ;; ;; Then add: ;; ;; (common to every emacs version): ;; ;; (autoload 'epop3-mail "epop3mail" ;; "Get mail from pop server for PO:USER@HOST and put it in TOFILE." t) ;; ;; (autoload 'start-biff "epop3mail" "pop3 biff, unleashed" t) ;; (autoload 'stop-biff "epop3mail" "pop3 biff, muzzled" t) ;; (autoload 'restart-biff "epop3mail" "pop3 biff, RE-unleashed" t) ;; (autoload 'flush-pop-passwords "epop3mail" "flush passwords" t) ;; (autoload 'stuff-pop-passwords "epop3mail" "pre-load passwords" t) ;; (autoload 'biffs-current-language "epop3mail" "what is biff talking?" t) ;; (autoload 'biffs-last-check "epop3mail" "when did biff last check?" t) ;; (autoload 'speak-biff! "biff-mode" "make biff speak" t) ;; ;; to your .emacs. ;; ;; You do *not* need to explicitly load pop3.el, epop3.el, or epop3hash.el. ;; ;; ;; (3) Adjust the user-settable variables to taste. ;; ;; To change the behavior of epop3mail, you can set the following ;; variables *prior* to loading or requiring epop3mail. These are: ;; ;; epop3-mail-package (default is 'rmail) ;; epop3-leave-mail-on-server (default is t) ;; epop3-password-style (default is 'cache) ;; ;; epop3-quietly (default is nil) ;; epop3-mail-debug (default is nil) ;; epop3-biff-debug (default is nil) ;; epop3-biff-absolutely-silent (default is nil) ;; epop3-biff-show-progress (default is nil) ;; epop3-biff-show-numbers (default is nil) ;; epop3-biff-show-barks (default is t) ;; epop3-biff-show-off-vocabulary (default is t) ;; epop3-biff-show-time (default is t) ;; epop3-biff-show-snooze (default is t) ;; epop3-biff-differential-mode (default is nil) ;; epop3-biff-idle-grace-seconds (default is 5) ;; epop3-biff-linear-bark-mode (default is nil) ;; epop3-override-pop3s-read-response (default is t) ;; epop3-open-server-timeout (default is 60) ;; epop3-authentication-always-use-default (default is t) ;; epop3-authentication-default (default is 'pass) ;; epop3-authentication-timeout-seconds (default is 3) ;; ;; These can also be set interactively via M-x set-variable. ;; ;; (Minor Relief For The Paranoid: if password caching is enabled, the ;; password cache can be flushed via 'M-x epop3-flush-password-cache'). ;; ;; Try using the defaults first. The debug variables are for when you run ;; into trouble and want to report details. ;; ;; (4) If you wish to have 'biff'-like functionality with your pop3 ;; server, you can call it interactively (M-x epop3-start-biff), or from ;; your .emacs via ;; ;; (epop3-start-biff [t]) ;; ;; or ;; (start-biff [t]) ;; ;; where is the number of minutes between polls and ;; optional 't' tells it to start with an immediate biff. ;; ;; You can stop the biffing via 'epop3-stop-biff' or 'stop-biff'. ;; ;; The start- and stop- biff commands can also be run interactively via M-x. ;; ;; If new mail is found on your pop3 server(s), the modeline will say ;; "Arf!" or an equivalent in one of many languages. (My understanding of ;; the origin of the name 'biff' is that the original BSD Unix utility was ;; named after a dog who always barked when the mailman came. This is ;; documented in The Jargon file. ;; ;; On dialup lines, the biff feature is a nice way to keep the connection ;; alive. ;; ;; ;; How it all works: ;; ;; The rmail function 'rmail-insert-inbox-text' is overridden by the ;; function of the same name below. This version is from emacs 19.34.6 ;; and may need to be revised to work with your version of rmail if your ;; Emacs is an earlier version than 19.34. ;; ;; If you modify 'rmail-insert-inbox-text' below to conform to your local ;; version of Rmail, be sure to add the changes marked 'pop3-mail change' ;; to it *before* the 't' cond clause (see code below). ;; ;; This has been tested on: ;; - FSF Emacs 19.34 on Solaris 2.5.1 and Windows 95 ;; ;; Bug reports and suggestions are welcome -- send them to Franklin Lee ;; . ;; ;; Also: if you know how dogs "bark" in other languages, please let me ;; know! ;; ;; THANKS TO: ;; ========== ;; for ntemacs: ;; ------------ ;; ;; ;; ;; for the original pop3.el: ;; ------------------------- ;; ;; ;; ;; testing, ideas, && patches: ;; --------------------------- ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; any omissions in the above, I apologize, the omission was NOT intentional! ;; ;; ;; i18n of dog barks: ;; ------------------ ;; ;; The credits for the i18n of dog barks have been moved to the comments ;; in the related biff-mode.el -- please see that source code. ;; ;; However, I would like to specially thank Professor Catherine Ball ;; and for her kind advice, and for her great ;; "Sounds of the World's Animals" page at ;; ;; http://www.georgetown.edu/cball/animals/animals.html ;; ;; and also to her linguistic informants (see biff-mode.el). ;; ;;; History: ;; -------- ;; ;; 11/??/1997 versions 0.0000001 through 0.5: initial versions ;; ;; 12/21/1997 version 0.6: added dohash macro to make ;; epop3-get-unread-message-numbers more readable and cleaner ;; ("Cleanth is next to Godth!"). ;; ;; 12/28/1997 version 0.7: added password and authentication-scheme ;; caching (see epop3-password-style). added semi-coherent documentation. ;; added 'biff' features. started i18n of biff messages. ;; ;; 01/02/1998 version 0.7.5: even more i18n. added (optional) unread ;; message count display ('epop3-biff-show-numbers') ;; ;; 01/08/1998 version 0.7.6: added spaces around 'barks' in mode line ;; (oops!). proper placement of biff info after display of time. minor ;; documentation fixes. added to installation notes. fixed problem(s) with ;; hash table access when in deleting-mail-from-server mode. changed ;; pop-* variables to epop3-* variables for consistency... ;; ;; 01/09/1998 version 0.7.7: cosmetic change to `epop3-append-message-to-file'. ;; made nice to folks without standard-display-european enabled. ;; clarified biff procedures; now biff will try to display something ;; the *first* time it biffs (unless it discovers it needs to go into ;; differential mode). previously it would only try to display something ;; on the *second* biff. if delete-mail-after-retrieve, biff clears ;; mode-line barks. ;; ;; 01/11/1998 version 0.7.8: separated dohash macro to its own file. ;; separated biff barking to biff-mode.el (speak, biff!). this makes ;; loading epop3mail faster for those who have epop3-biff-show-barks as ;; nil. added biff-idle-timer logic. added snooze logic. eliminated ;; annoying mode-line clearing in `epop3-biff'. eliminated annoying 'mark ;; set' message caused by `epop3-init-tables'. started linear-bark mode. ;; ;; 01/21/1998 version 0.7.9: added epop3-biff-show-mail-string option ;; for mode line display. Some people like to see '[Mail: 4]' with their ;; numbers. fixed "*invalid*" modeline display error -- occurred in ;; console-mode (emacs -nw) as well as occasionally in window mode. ;; ;; 01/31/1998 version 0.8: added `inhibit-quit' processing in function ;; `epop3-idle-timed-biff'. added `epop3-open-server-timeout'. added ;; `epop3-overide-pop3-read-response' flag to cope with some people's ;; problems with their POP3 servers hanging in weird ways and not ;; reporting back to epop3mail (i.e., going into ga-ga land...). ;; ;; 02/15/1998 version 0.9: added preliminary Emacs v 20.2 compatibility ;; stuff from patches sent in by and ;; testing help from (I don't have a working ;; v 20.2 and am unlikely to have one in the near future...) ;; ;; 03/30/1998 version 0.9.1: made epop3-prompt-authentication-scheme ;; immune to mouse clicks (annoying!) and have a configurable timeout and ;; default (thanks to for suggesting the ideas). ;; also, epop3-prompt-authentication-scheme flushes input, so you don't ;; get that annoying null password syndrome... (thanks to ;; for pointing out the syndrome). ;; ;; 07/25/1998 version 0.9.2: incorporated epop3-biff-hook code from ;; . Cool. ;; ;; 08/08/1998 version 0.9.3: incorporated Gnus compatibility stuff thanks ;; to . Tres cool. See references to ;; Gnus in the Usage section above. ;; ;; 08/12/1998: version 0.9.4.beta: added ;; `epop3-authentication-always-use-default' so that you can avoid ;; the "annoying" authentication query the first time for each mailbox. ;; this only is helpful when you have exactly one mailbox or all of ;; your mailboxes use the same authentication scheme. It's been asked ;; for several times, so why not add it? ;; ;; 08/13/1998: version 0.9.4.gamma: documentation changes for jvinson's ;; review... ;; ;; 08/15/1998: version 0.9.5: oops! biff doesn't know about ;; nnmail-spool-file yet! More fixes... now uses epop3-mailbox-list ;; ;; 11/03/1998: version 0.9.5.01: incorporate clarifications suggested ;; by jvinson@chevax.ecs.umass.edu about Gnus initializations. ;; ;; 11/05/1998: version 0.9.6: new function to permit external elisp code ;; to change epop3-mailbox-list after initialization. this is nice if you ;; have a long emacs session yet want to change the pop3 server(s) being ;; queried without having to exit & re-enter emacs... see ;; `epop3-set-mailboxes' below. ;; ;; also incorporated `epop3-submit-bug-report' into this file from ;; epop3bugs.el. ;; ;; 11/14/1998: version 0.9.7.beta: function epop3-get-list is now used ;; only as a very last resort (changed epop3-get-message-numbers). this ;; is to permit switching from leave-mail-on-server to delete-from without ;; re-retrieval of every message. UIDL, if supported by the server, will ;; always be used now. ;; ;; adding "from" and "subject" fields to the epop3-uid-entry structure ;; in preparation for selective deletion of mail on the server. ;; this will come in handy when the imap4 version of epop3mail gets ;; developed (I hope!) ;; ;; added function epop3-set-default-mailboxes-by-mode and call it from ;; start-biff for extra insurance. If the .emacs initialization is in the ;; wrong order it is possible to get mail but not biff -- which is ;; extremely confusing. the call to epop3-set-default-mailboxes-by-mode ;; should minimize this problem from recurring even with incorrect ;; initializations. ;; ;; 11/19/1998: version 0.9.7.gamma: changed epop3-init-tables to accept ;; parse 'from' and 'subject' data to be stored in the uidl file and the ;; uidl hash tables at initialization. needed for future management of ;; messages... e.g., selective deletes if we're not deleting mail as we ;; go.... ;; ;; 11/21/1998: version 0.9.7.delta: minor defstruct changes to accomodate ;; epop3manage.el's functionality. ;; ;; 02/02/1999: modified the eval-when-compile suggested by jari aalto ;; ;; 02/15/1999: version 0.9.7: added epop3-stuff-passwords for ;; d.l.dwiggins@computer.org -- makes handling multiple servers ;; easier when big mailboxes are downloaded. ;; ;; -------------------------------------------------------------------------- ;; ;; ====== ;; TO-DO: ;; ====== ;; - better caching of uidls when biffing and show-numbers -- way too ;; much consing when building and destroying UIDL hash tables! ;; - perhaps using obarrays instead of cl-hash tables for speedth? ;; - perhaps integrate (or make an option to display) the functionality ;; of the 'reportmail' package? ;; ;; ;; proposes: ;; ;; >> And while I'm here, why use [%3d] when displaying the number of ;; >> messages? The extra spaces detract some from the desired effect I ;; >> think. Now think this; make all barks occur just once, then instead of ;; >> a number, put in the number of barks as there are messages: ;; ;; >> Boj! = one message ;; >> Woof Woof! = two messages ;; >> Bhauji Bhauji Bhauji! = 3 messages. ;; >> Gaf Gaf Gaf Gaf! + = more than 4 messages ;; ;; Maybe we gotta implement something like this: ;; ;; (defvar epop3-biff-linear-bark-mode nil ;; "*Set this to non-nil to have Biff bark 'number of message' times. ;; If set to non-nil, this variable overrides `epop3-biff-show-numbers', ;; and enables a special horizontal-scroll hack for the mode-line.") ;; ;;; }}} ;;; Code: ;;; {{{ (eval-when-compile (require 'cl) (require 'ange-ftp)) (require 'biff-mode) (require 'timer) (require 'pop3) (require 'epop3) (require 'nnmail) ;;; {{{ the 'dohash' macro for going through hash tables (require 'epop3hash) ;;; }}} {{{ user-option variables which are settable via 'M-x set-variable' (defvar epop3-mail-package 'rmail ;; jvinson "The mail package that epop3 uses. Valid entries are 'rmail and 'gnus.") (defvar epop3-mailbox-list nil) (defun epop3-set-mailboxes (mboxes &optional mode) "Set the epop3mail's mailbox list to be MBOXES according to MODE. Example: (setq my-usual-inbox-list '(\"po:myself@mymainplace.com\")) (setq my-sometimes-inbox-list '(\"po:myself@sometimes.com\")) Then prior to retrieving mail from the usual place via POP: (epop3-set-mailboxes my-usual-inbox-list) Suppose then you disconnect and reconnect to a second dial-up service without having exitted emacs/epop3mail. You might then do (epop3-set-mailboxes my-sometimes-inbox-list) and then retrieve mail from there." (case (or mode epop3-mail-package) ;;---- rmail case has been semi-tested by flee 11/05/1998 (rmail (save-excursion (and (get-buffer "RMAIL") (set-buffer "RMAIL")) (setq epop3-mailbox-list mboxes rmail-inbox-list mboxes rmail-primary-inbox-list mboxes))) ;;---- gnus case IS UNTESTED as of 11/05/1998 (gnus (setq epop3-mailbox-list (if (listp mboxes) mboxes (list mboxes)))))) (defun epop3-set-default-mailboxes-by-mode () "Set the default value for `epop3-mailbox-list'. Variable `epop3-mail-package' must have been set previously." (interactive) (case epop3-mail-package (rmail (or (featurep 'rmail) (require 'rmail)) (epop3-set-mailboxes rmail-primary-inbox-list)) (gnus (epop3-set-mailboxes nnmail-spool-file)))) ;; set the default mailboxes NOW (epop3-set-default-mailboxes-by-mode) (defvar epop3-open-server-timeout 60 "*Number of seconds before a timeout occurs in opening a connection.") (defvar epop3-authentication-default 'pass "*Default POP3 authentication to be used.") (defvar epop3-authentication-always-use-default t "*Always use 'epop3-authentication-default' and don't query. This overrides `epop3-authentication-timeout-seconds' waiting. Setting `epop3-authentication-timeout-seconds' to t is useful only in when you have one mailbox to query OR all of your mailboxes use the same authentication scheme.") (defvar epop3-authentication-timeout-seconds 3 "*Number of seconds before timing out on authentication question.") (defvar epop3-override-pop3s-read-response t "*Non-nil if you want to override pop3.el's function; see below.") (defvar epop3-leave-mail-on-server t "*Non-nil if leave mail on POP3 server; otherwise DELEtes the mail.") (defvar epop3-password-style 'cache "*Valid values are: ask, cache, or nil. ask and nil mean ask for password each time mail is retrieved. cache means save passwords per user@host for use in subsequent retrievals. You can flush the cached passwords (for security purposes) via the interactive function 'epop3-flush-password-cache'") (defvar epop3-quietly nil "*Set this to non-nil to suppress progress messages while getting mail.") (defvar epop3-biff-absolutely-silent nil "*Set this to non-nil to completely disable biff's progress display. If this variable is nil, then If 'epop3-biff-show-progress is nil, only show when biff is snooping. If 'epop3-biff-show-progress is t, show biff's complete progress.") (defvar epop3-biff-show-progress nil "*Set this to non-nil to show ALL of biff's progress when snooping. This value is ignored if 'epop3-biff-absolutely-silent' is set to non-nil.") (defvar epop3-biff-show-barks t "*Set this to non-nil for 'biff' to bark on the mode-line for new mail.") (defvar epop3-biff-show-snooze t "*Set this to non-nil for 'biff' to snooze on the mode-line when no mail.") (defvar epop3-biff-show-numbers nil "*Set this to non-nil for 'biff' to display the # of unread messages.") (defvar epop3-biff-show-mail-string nil "*Set this to non-nil for 'biff' to show '[Mail: ]' in the modeline. This is only meaningful when `epop3-biff-show-numbers' is non-nil.") (defvar epop3-biff-show-off-vocabulary t "*Set this to non-nil for 'biff' to show off his vocabulary with each biff. If set to nil, 'biff' will only change barks if the number of pending messages changes.") (defvar epop3-biff-show-time t "*Set this to non-nil to display the time of last biff in modeline.") (defvar epop3-biff-ding t "*Set this to non-nil to bave Biff 'ding' if there's new mail.") (defvar epop3-mail-debug nil "*Set this to non-nil if debugging `epop3-mail'.") (defvar epop3-biff-debug nil "*Set this to non-nil if debugging the biff features of `epop3-mail'.") (defvar epop3-biff-differential-mode nil "*Set this to non-nil to force biff counting to be differential. This will speed up biffing when `epop3-leave-mail-on-server' is t, because the POP3 STAT command is used (quick) instead of the POP3 UIDL command (possibly expensive). The downside to setting this to t, is that Biff cannot bark the *first* time it biffs when `epop3-leave-mail-on-server' is t. Biff counting will ordinarily try to use the unread message count, but if UIDL is found to be unsupported, then biff can only determine new messages by taking the difference between two successive *total* message counts, and this variable will be set to t internally. This value is IGNORED if `epop3-leave-mail-on-server' is nil; otherwise, this value is set in `epop3-set-biff-differential-mode' if UIDL support is not found.") (defvar epop3-biff-idle-grace-seconds 5 "*Number of seconds Emacs must be idle before a scheduled biff happens.") (defvar epop3-biff-linear-bark-mode nil "*Set this to non-nil to have Biff bark 'number of message' times. If set to non-nil, this variable overrides `epop3-biff-show-numbers', and enables a special horizontal-scroll hack for the mode-line. Not yet implemented ;-).") (defvar epop3-biff-hook nil "List of functions to call after biffing. Each function is called with two arguments: the current and previous number of available messages. For example, to ring the bell once for each new message detected, use something like this: (add-hook 'epop3-biff-hook (function (lambda (n old-n) (while (> n old-n) (beep) (sit-for 0.2) (setq n (1- n))))))") (defvar epop3-biff-optimize-if-possible t "*Set this to non-nil if you want biff to cache the tables whenever it can.") ;;; }}} {{{ INTERNAL VARIABLES ;; ;; 'UID' stands for Unique ID ;; 'UIDL' stands for Unique ID List ;; (defstruct epop3-uid-entry (uid nil :read-only t) (msgno nil) (gotten nil) (date "") (from "") (subj "") (nchars 0) (onserver nil) (todelete nil)) (defstruct epop3-msgno-entry (msgno nil :read-only t) (uid nil) (nchars 0)) (defstruct epop3-password-entry (user@host nil :read-only t) (password nil) (authentication nil)) (defconst epop3-initial-count -1 "Value for last-count at initialization.") (defconst epop3-biff-snooze-string " Zzzz... " "Value for biff's snoozing on mode-line if `epop3-biff-show-snooze'.") (defstruct epop3-host-entry (user@host nil :read-only t) ;; uidl-support's values: dontknow, yes, no (uidl-support 'dontknow) (last-count epop3-initial-count)) (defvar epop3-utab nil "Uidl hash table for epop3mail.") (defvar epop3-mtab nil "Msgno hash table for epop3mail.") (defvar epop3-ptab (make-hash-table :test 'equal) "Password hash table for epop3mail.") (defvar epop3-htab (make-hash-table :test 'equal) "Host table for epop3mail.") (defvar epop3-biff-timer nil "Timer for biffing.") (defvar epop3-biff-idle-timer nil "Idle timer for biffing.") (defvar epop3-biff-interval 5 "Interval in minutes between biffs.") (defvar epop3-last-biff-at "" "Text string describing time of last biff (for debugging).") (defvar epop3-mode-line-info "" "Mode line display string for `epop3-biff'.") (defvar epop3-biffed-at-least-once nil "Non-nil if biffing has been requested at least once.") (defvar epop3-biffing nil "Non-nil if biffing is enabled.") (defvar epop3-current-bark nil "Biff's current bark, if any.") (defvar epop3-old-n 0 "Number of available messages at last check.") (defvar epop3-unix-mail-delimiter ;; jvinson (if (eq epop3-mail-package 'gnus) message-unix-mail-delimiter rmail-unix-mail-delimiter) "The regexp string used to delimit messages in UNIX mail format.") (defvar epop3-biff-optimized-and-read nil "Set to t if optimizable and hash tables have been read in once.") (defconst epop3-mail-help-address "flee@lehman.com" "Present location of epop3mail's maintainer.") (defconst epop3-mail-version "0.9.7.delta" "Version of epop3mail.") ;;; }}} {{{ the main read mail function (defun epop3-mail (po:user@host tofile) "Get mail from pop server for PO:USER@HOST and put it in TOFILE." (when epop3-mail-debug (message "starting epop3-mail...") (sit-for 1)) (let ((tmpbuf (get-buffer-create "*pop3-retr*")) (biffing epop3-biffing) (msgnums nil) process) (multiple-value-bind (user host) (epop3-parse-po:user@host po:user@host) (setq process (epop3-open-server host pop3-port t)) (when biffing (epop3-stop-biff)) (unwind-protect (save-excursion (when epop3-mail-debug (switch-to-buffer (process-buffer process))) (epop3-login process user host epop3-quietly) (setq msgnums (epop3-get-message-numbers process user host epop3-quietly)) (when msgnums (let ((msgsleft (1- (length msgnums)))) (mapc ;;; {{{ the main message retrieval lambda (lambda (msgno) (message (format "retrieving # %d; %d remaining" msgno msgsleft)) (pop3-retr process msgno tmpbuf) (epop3-update-uid-header-fields-from-buffer tmpbuf msgno) (epop3-append-message-to-file tmpbuf tofile host) (when (and epop3-leave-mail-on-server (eq 'yes (epop3-uidl-support user host))) (epop3-update-uid-as-gotten msgno)) (epop3-clear-buffer tmpbuf) (unless epop3-leave-mail-on-server (pop3-dele process msgno)) (decf msgsleft)) ;;; }}} msgnums)) (when epop3-leave-mail-on-server (when (eq 'yes (epop3-uidl-support user host)) (epop3-save-uidls)) (when (and biffing epop3-biff-differential-mode) (epop3-update-message-count user host (epop3-get-stat process t)))))) (save-excursion (let ((proc-buffer (process-buffer process))) (pop3-quit process) (unless epop3-mail-debug (kill-buffer tmpbuf) (kill-buffer proc-buffer)) (when biffing (epop3-start-biff epop3-biff-interval)))))))) (defun epop3-flush-password-cache () "Discard all cached pop passwords. This is a security feature for when you step away from your Emacs session and somebody comes by and evaluates (describe-variable (quote epop3-ptab))" (interactive) (stop-biff) ; if biff is running, stop it. (clrhash epop3-ptab)) (defalias 'flush-pop-passwords 'epop3-flush-password-cache) (defun epop3-stuff-passwords () "Pre-stuff passwords into password cache." (interactive) (cond ((not (eq epop3-password-style 'cache)) (message "can't stuff passwords unless epop3-password-style is 'cache")) (t (epop3-set-default-mailboxes-by-mode) (mapc (lambda (mbox) (when (and (string-match "^po:" (file-name-nondirectory mbox)) (string-match "@" mbox)) (let ((user@host (epop3-strip-through-semicolon mbox))) (epop3-set-authentication-scheme user@host) (epop3-set-password user@host)))) epop3-mailbox-list)))) (defalias 'stuff-pop-passwords 'epop3-stuff-passwords) ;;; }}} {{{ biff support (defun epop3-biff-optimizable-p () "Determines if biff hash table processing can be optimized." (interactive) (epop3-set-default-mailboxes-by-mode) (when (= 0 (length epop3-mailbox-list)) (error "Check your configuration -- epop3-mailbox-list is incorrect!")) (and epop3-biff-optimize-if-possible (= 1 (length epop3-mailbox-list)))) (defun* epop3-start-biff (minutes &optional now) "Initiate biffing every MINUTES minutes, optionally start biffing NOW." (interactive "NHow many minutes between biff checks? ") (unless (or epop3-biff-show-barks epop3-biff-show-numbers) (message "uh.. check your configuration, biff can't display anything.") (return-from epop3-start-biff)) ;; the following 3 lines were added 11/15/1998 just in case somebody ;; did their configuration a bit incorrectly -- be nice! (epop3-set-default-mailboxes-by-mode) (when (= 0 (length epop3-mailbox-list)) (error "Check your configuration -- epop3-mailbox-list is incorrect!")) ;; ---------------- clear out current biff parameters --------------- (and epop3-biff-timer (cancel-timer epop3-biff-timer)) (and epop3-biff-idle-timer (cancel-timer epop3-biff-idle-timer)) (when (memq 'epop3-mode-line-info global-mode-string) (remove-hook 'global-mode-string 'epop3-mode-line-info)) (setq epop3-biff-timer nil epop3-biff-idle-timer nil epop3-biffing nil epop3-biffed-at-least-once t epop3-old-n 0) (epop3-format-mode-line nil) ;; ---------------------- now start fresh ------------------------- (cond ((not (eq epop3-password-style 'cache)) (message "can't biff unless epop3-password-style is 'cache")) ((and (< 0 minutes) (< 0 (length epop3-mailbox-list))) (when (and (interactive-p) (null now)) (setq now (y-or-n-p "Do a biff immediately too? ")) (message "")) (unless (memq 'epop3-mode-line-info global-mode-string) (add-hook 'global-mode-string "" t nil);; 980121 fix for console (add-hook 'global-mode-string 'epop3-mode-line-info t nil)) (setq epop3-biffing t epop3-biff-interval minutes) (epop3-format-mode-line 0) (if now (epop3-biff-all-mailboxes) (setq epop3-biff-timer (run-at-time (* 60 minutes) nil ; no repeat 'epop3-idle-timed-biff)))))) (defalias 'start-biff 'epop3-start-biff) (defun epop3-stop-biff () "Stop the background biffing cycle." (interactive) (maphash (lambda (key h-entry) (setf (epop3-host-entry-last-count h-entry) epop3-initial-count)) epop3-htab) (epop3-start-biff -1)) (defalias 'stop-biff 'epop3-stop-biff) (defun epop3-restart-biff () "Restart the background biffing cycle." (interactive) (epop3-stop-biff) (call-interactively 'epop3-start-biff)) (defalias 'restart-biff 'epop3-restart-biff) (defun epop3-idle-timed-biff () "When activated, waits for some idle seconds before actually biffing. This is so that activity at the keyboard won't be interrupted." (setq quit-flag nil) ;; recommended by `inhibit-quit's documentation (let ((inhibit-quit nil)) (and epop3-biff-idle-timer (cancel-timer epop3-biff-idle-timer)) (if (not (sit-for epop3-biff-idle-grace-seconds 0 t)) (setq epop3-biff-idle-timer (run-with-idle-timer epop3-biff-idle-grace-seconds nil ; no repeat 'epop3-biff-all-mailboxes)) (epop3-biff-all-mailboxes)))) (defun epop3-biff-all-mailboxes () "Loop through all pop3 mailboxes and biff each one." (interactive) (let ((got-one nil) (total-unread 0)) (mapc (lambda (mbox) (when (and (string-match "^po:" (file-name-nondirectory mbox)) (string-match "@" mbox)) (setq got-one t) (setq total-unread (epop3-biff mbox total-unread)))) epop3-mailbox-list) ;; ;; if we don't find a biff-able mailbox, stop biffing! ;; (if (not got-one) (epop3-stop-biff) (setq epop3-biff-timer (run-at-time (* 60 epop3-biff-interval) nil ; no repeat 'epop3-idle-timed-biff))))) (defun epop3-biff (po:user@host accum-unread) "Check mail status for PO:USER@HOST. This is very much like the mail retrieval except we don't get the mail. Returns the accumulated number of unread messages waiting ACCUM-UNREAD (if any) from this round of polling. If `epop3-leave-mail-on-server' is t and UIDL is supported by all of the pop3 servers in `rmail-primary-inbox-list', this can be an expensive operation, since the UIDL command is used instead of the STAT command. See `epop3-poll-unread' for where the expense comes from." (unless epop3-biff-absolutely-silent (message (format "biffing %s..." po:user@host))) (let ((tmpbuf (get-buffer-create " *pop3-biff*")) (msgcount -1) (process nil) (hush! (if epop3-biff-absolutely-silent t (not epop3-biff-show-progress)))) (multiple-value-bind (user host) (epop3-parse-po:user@host po:user@host) (setq process (epop3-open-server host pop3-port)) (unwind-protect (save-excursion (when epop3-biff-debug (switch-to-buffer (process-buffer process))) (epop3-login process user host hush!) (setq msgcount (epop3-poll-unread process user host hush!)) (epop3-bark-if-necessary user host msgcount accum-unread)) (save-excursion (let ((proc-buffer (process-buffer process))) (pop3-quit process) (unless epop3-biff-debug (kill-buffer tmpbuf) (kill-buffer proc-buffer)) (+ accum-unread msgcount)) (setq epop3-last-biff-at (current-time-string)) (unless epop3-biff-absolutely-silent (message (if epop3-biff-show-time (format "biffing %s...done at %s." po:user@host (format-time-string "%R" (current-time))) (format "biffing %s...done." po:user@host))))))))) (defun epop3-bark-if-necessary (user host n total) "Bark if there are new messages detected for USER @ HOST. N is the number of unread messages for this mailbox. TOTAL is the accumulated number of unread messages in other mailboxes." (cond (epop3-biff-differential-mode ;; we have to do some fancier stuff if we're in difference-mode (epop3-differential-mode-bark-if-necessary user host n total)) (t ;; otherwise we assume that 'n' is the number of unread messages (epop3-format-mode-line (+ n total))))) (defun epop3-differential-mode-bark-if-necessary (user host n total) "Bark if there are new messages detected for USER @ HOST. N is the number of unread messages for this mailbox. TOTAL is the accumulated number of unread messages in other mailboxes. Differential mode means that biff must check the count of the last biff for this mailbox and see if there's a difference. If so, biff will bark." (let* ((user@host (concat user "@" host)) (last-count (epop3-host-entry-last-count (gethash user@host epop3-htab)))) (cond ((= last-count epop3-initial-count) ;; for the first time, set the baseline count (setf (epop3-host-entry-last-count (gethash user@host epop3-htab)) n)) ((/= last-count n) ;; else bark if there's a difference in counts (epop3-format-mode-line (+ n total))) (t (epop3-format-mode-line 0))))) (defun epop3-set-biff-differential-mode () "Puts biffing into differential mode when UIDL is unsupported. This may happen if `epop3-leave-mail-on-server' is t and one of the POP3 servers in `rmail-primary-inbox-list' doesn't support the UIDL command." (when (and epop3-biffing (not epop3-biff-differential-mode)) (epop3-stop-biff) (message "epop3-biff: UIDL unsupported -- restarting biff...") (sit-for 1) (epop3-start-biff epop3-biff-interval t)) (setq epop3-biff-differential-mode t)) (defun epop3-spaces-around (str) "Put spaces around STR." (concat " " str " ")) (defun epop3-describe-current-bark () "Describe the language(s) that biff is currently speaking in the mode-line." (interactive) (cond ((not epop3-biff-show-barks) (message "You didn't allow Biff to bark...")) ((null epop3-current-bark) (message "Biff is not speaking in the mode-line at the moment.")) ((string= epop3-current-bark epop3-biff-snooze-string) (message "Biff is taking nap now.")) (t (or (featurep 'biff-mode) (require 'biff-mode)) (message (mapconcat 'identity (biff-get-languages-for epop3-current-bark) ", "))))) (defalias 'biffs-current-language 'epop3-describe-current-bark) (defun epop3-last-biff-was-at () "Tell when biff last checked the mailboxes." (interactive) (message (concat "biff last checked for mail at " epop3-last-biff-at))) (defalias 'biffs-last-check 'epop3-last-biff-was-at) (defun epop3-biff-snooze-string () "Return a valid snooze string." (if epop3-biff-show-snooze epop3-biff-snooze-string "")) (defun epop3-biff-mail-string () "Return a valid 'mail' string." (if epop3-biff-show-mail-string "Mail: " "")) (defun epop3-format-mode-line (&optional n) "Set the mode-line string for biff. Parameter N is the number to display if `epop3-biff-show-numbers' is enabled. If N is nil, clear the mode line." (when n (run-hook-with-args 'epop3-biff-hook n epop3-old-n)) (cond ((null n) (setq epop3-mode-line-info "" epop3-current-bark (epop3-biff-snooze-string))) ((zerop n) (setq epop3-mode-line-info (epop3-biff-snooze-string) epop3-current-bark (epop3-biff-snooze-string))) (t (when epop3-biff-show-barks (or (featurep 'biff-mode) (require 'biff-mode)) (setq epop3-current-bark (biff-get-bark))) (when epop3-biff-ding (ding)) (setq epop3-mode-line-info (cond ((and epop3-biff-show-numbers epop3-biff-show-barks) (epop3-spaces-around (format "[%s%d] %s" (epop3-biff-mail-string) n epop3-current-bark))) (epop3-biff-show-numbers (setq epop3-current-bark nil) (epop3-spaces-around (format "[%s%d]" (epop3-biff-mail-string) n))) (epop3-biff-show-barks (epop3-spaces-around epop3-current-bark)) (t ""))) (setq epop3-old-n (or n 0))))) (defun epop3-update-message-count (user host n) "Set `last-count' for this USER and HOST to N after a mail retrieval. We do this when biff is in differential-mode." (when (and epop3-biff-differential-mode epop3-leave-mail-on-server) (let ((user@host (concat user "@" host))) (setf (epop3-host-entry-last-count (gethash user@host epop3-htab)) n)))) ;;; }}} {{{ uidl support functions (defconst epop3-uidl-file-name "~/.uidls") (defconst epop3-current-uidl-file nil) (defun epop3-get-message-numbers (process user host &optional quietly) "Get the list of message numbers to retrieve via PROCESS for USER @ HOST. Optionally do so QUIETLY." ;; ;; see if the UIDL command is implemented. if so, we use it to get the ;; message number list. ;; ;; if 'quietly', don't output progress messages. ;; ;; if we find that UIDL is unsupported then we just use the LIST ;; command -- we don't have a choice if UIDL is unsupported. ;; (case (epop3-uidl-support user host) ((yes dontknow) (or (epop3-get-uidl process user host quietly))) (otherwise (epop3-get-list process quietly)))) ;;; (or (cond ;;; (epop3-leave-mail-on-server ;;; (case (epop3-uidl-support user host) ;;; ((yes dontknow) (epop3-get-uidl process user host quietly)) ;;; (otherwise (epop3-get-list process quietly)))) ;;; (t ;;; (epop3-get-list process quietly))) ;;; ;; fallback for the dontknow and failed case ;;; (and epop3-leave-mail-on-server ;;; (eq 'no (epop3-uidl-support user host)) ;;; (epop3-get-list process quietly)))) (defun epop3-uidl-support (user host) "Return the status of UIDL command supported for this USER HOST pair. Return 'yes, 'dontknow, or 'no." (epop3-host-entry-uidl-support (gethash (concat user "@" host) epop3-htab))) (defun epop3-get-uidl (process user host &optional quietly) "Use PROCESS to get a list of unread message numbers for USER and HOST. Do this by issuing a POP3 UIDL command, QUIETLY if necessary. Also remember if UIDL is supported for this USER/HOST combination." (unless quietly (message "uidl...")) (let ((pairs (pop3-uidl process)) (hashkey (concat user "@" host))) (cond (pairs (epop3-init-tables (concat user "." host)) (mapcar 'epop3-update-uidl-results (cdr pairs)) (setf (epop3-host-entry-uidl-support (gethash hashkey epop3-htab)) 'yes) (epop3-get-unread-message-numbers)) (t (setf (epop3-host-entry-uidl-support (gethash hashkey epop3-htab)) 'no) (epop3-set-biff-differential-mode) nil)))) (defun epop3-get-list (process &optional quietly) "Issue a POP3 LIST command to PROCESS and return a list of message numbers. Do so QUIETLY if asked to." (unless quietly (message "list...")) (mapcar (lambda (pair) (car pair)) (cdr (pop3-list process)))) (defun epop3-poll-unread (process user host &optional quietly) "Via PROCESS, determine the number of unread messages for USER/HOST. Do so QUIETLY if asked to" (cond ((and epop3-leave-mail-on-server (not epop3-biff-differential-mode)) ;; the UIDL command can get expensive here for just determining ;; the number of unread messages... (length (epop3-get-message-numbers process user host quietly))) (t ;; getting the number of unread messages for ;; epop3-biff-differential-mode or for delete-mail-after-retrieve ;; is much quicker (epop3-get-stat process quietly)))) (defun epop3-get-stat (process &optional quietly) "Issue a POP3 STAT command to PROCESS and return its value. Do so QUIETLY if asked to." (unless quietly (message "stat...")) (car (pop3-stat process))) ;; adapted from pop3.el (defun epop3-line-to-list (string &optional regexp) "Chop up a line at point into a list. Argument STRING . Optional argument REGEXP ." (interactive) (let ((list) (regexp (or regexp " ")) (string (if (string-match "\n" string) (substring string 0 (match-beginning 0)) string))) (store-match-data nil) (while string (if (string-match regexp string) (setq list (cons (substring string 0 (- (match-end 0) 1)) list) string (substring string (match-end 0))) (setq list (cons string list) string nil))) (nreverse list))) ;; snarfed from bbdb somewhere (defsubst epop3-string-trim (string) "Lose leading and trailing whitespace from STRING." (if (string-match "\\`[ \t\n]+" string) (setq string (substring string (match-end 0)))) (if (string-match "[ \t\n]+\\'" string) (substring string 0 (match-beginning 0)) string)) (defun epop3-init-tables (fname) "Create the hash tables for uidl processing from data in FNAME." (save-excursion (let ((lst nil) (uid nil) (rec nil) (nc nil) (frm nil) (date nil) (subj nil) (inbuf (generate-new-buffer "*uidls-in*"))) (set-buffer (get-buffer inbuf)) (setq epop3-current-uidl-file (concat epop3-uidl-file-name "." fname)) (if (hash-table-p epop3-mtab) (clrhash epop3-mtab) (setq epop3-mtab (make-hash-table :test 'equal))) (cond ((epop3-biff-optimizable-p) (unless (hash-table-p epop3-utab) (setq epop3-utab (make-hash-table :test 'equal))) (cond (epop3-biff-optimized-and-read (epop3-dohash (uid entry epop3-utab) (setf (epop3-uid-entry-onserver entry) nil ;;; (epop3-uid-entry-todelete entry) nil (epop3-uid-entry-msgno entry) 0))) (t (when (file-readable-p epop3-current-uidl-file) (insert-file-contents epop3-current-uidl-file))))) (t ;; otherwise make the hash tables fresh unconditionally (if (hash-table-p epop3-utab) (clrhash epop3-utab) (setq epop3-utab (make-hash-table :test 'equal))) (when (file-readable-p epop3-current-uidl-file) (insert-file-contents epop3-current-uidl-file)))) (unless (and (epop3-biff-optimizable-p) epop3-biff-optimized-and-read) (when epop3-mail-debug (message "parsing uidls...")) (goto-char (point-min)) (while (looking-at "\\(.*\n\\)") (setq lst (epop3-line-to-list (buffer-substring (match-beginning 1) (match-end 1)) " +")) ;; see epop3-insert-uid for the order of the record! (setq uid (nth 0 lst)) (setq nc (nth 1 lst)) (setq date (nth 2 lst)) (setq frm (nth 3 lst)) (setq subj (mapconcat 'identity (nthcdr 4 lst) " ")) (setq rec (make-epop3-uid-entry :uid uid)) (setf (epop3-uid-entry-nchars rec) (or (and nc (string-to-int nc)) 0) (epop3-uid-entry-date rec) (or date "") (epop3-uid-entry-from rec) (or frm "") (epop3-uid-entry-subj rec) (or subj "") (epop3-uid-entry-gotten rec) t (epop3-uid-entry-onserver rec) nil) (puthash uid rec epop3-utab) (forward-line 1))) (when (epop3-biff-optimizable-p) (setq epop3-biff-optimized-and-read t)) (kill-buffer inbuf)))) (defun epop3-get-unread-message-numbers () "Return a sorted list of unread msg numbers to retrieve." (let ((epop3-tmplist '()) (msgno nil) (gotten nil) (onserver nil)) (epop3-dohash (uid u-entry epop3-utab (sort epop3-tmplist '<)) (setq msgno (epop3-uid-entry-msgno u-entry) gotten (epop3-uid-entry-gotten u-entry) onserver (epop3-uid-entry-onserver u-entry)) (when (and msgno (not gotten) onserver) (push msgno epop3-tmplist))))) (defun epop3-update-uidl-results (pair) "Update uidl-hash tables given a PAIR list (msgno uid)." (let ((msgno (car pair)) (uid (cadr pair)) (m-entry (gethash (car pair) epop3-mtab)) (u-entry (gethash (cadr pair) epop3-utab))) (if m-entry (setf (epop3-msgno-entry-uid m-entry) uid) (puthash msgno (make-epop3-msgno-entry :uid uid :msgno msgno) epop3-mtab)) (if u-entry ;; update the existing entry (setf (epop3-uid-entry-msgno u-entry) msgno (epop3-uid-entry-onserver u-entry) t) ;; else put a new entry in (puthash uid (make-epop3-uid-entry :uid uid :msgno msgno :onserver t) epop3-utab)))) (defun epop3-update-list-results (pair) "Update `epop3-mtab' with msgno and nchars from PAIR (msgno nchars)." (let ((msgno (car pair)) (nchars (cadr pair)) (m-entry (gethash (car pair) epop3-mtab)) (uid (epop3-msgno-2-uidl (car pair))) (u-entry nil)) (if m-entry (setf (epop3-msgno-entry-nchars m-entry) nchars) (puthash msgno (make-epop3-msgno-entry :msgno msgno :nchars nchars) epop3-mtab)) (when uid (setq u-entry (gethash uid epop3-utab)) (when u-entry (setf (epop3-uid-entry-nchars u-entry) nchars) (setf (epop3-uid-entry-onserver u-entry) t))))) (defun epop3-save-uidls () "Save the updated UIDLs to disk for use next time." ;; ;; write the uidl, msgid to the local uidl file EXCEPT the ones which ;; don't have msgnos, since they've been deleted from the server ;; (when (and epop3-leave-mail-on-server epop3-utab (hash-table-count epop3-utab)) (save-excursion (let ((outbuf (generate-new-buffer "*uidls-out*"))) ;; back this up because we'll write to it later. (when (file-readable-p epop3-current-uidl-file) (copy-file epop3-current-uidl-file (concat epop3-current-uidl-file ".old") t t)) (set-buffer outbuf) (erase-buffer) (maphash 'epop3-insert-uid epop3-utab) (write-file epop3-current-uidl-file) (kill-buffer outbuf))))) (defun epop3-msgno-2-uidl (msgno) "Given a MSGNO, see if we can get the corresponding UIDL. This assumes that the uidl and msgno hash tables have been initialized correctly." (and (hash-table-p epop3-mtab) (epop3-msgno-entry-uid (gethash msgno epop3-mtab)))) (defun epop3-update-uid-as-gotten (msgno) "Update the uid hash table for MSGNO as 'gotten'." (let ((this-uid (epop3-msgno-2-uidl msgno))) (when this-uid (setf (epop3-uid-entry-gotten (gethash this-uid epop3-utab)) t)))) (defun epop3-insert-uid (uid u-entry) "Insert a valid UID from the hash table at point. U-ENTRY should correspond to UID. Only UIDLs corresponding to messages we`ve actually seen or retrieved are inserted." (let ((msgno (epop3-uid-entry-msgno u-entry)) (gotten (epop3-uid-entry-gotten u-entry)) (date (epop3-uid-entry-date u-entry)) (frm (epop3-uid-entry-from u-entry)) (nc (epop3-uid-entry-nchars u-entry)) (sub (epop3-uid-entry-subj u-entry)) (onserver (epop3-uid-entry-onserver u-entry)) (fmt nil)) (when (and msgno gotten onserver) (setq fmt (format "%s %d %s %s %s" uid nc date frm sub)) (insert (format "%s\n" (epop3-string-trim fmt)))))) ;;; }}} {{{ other support functions (defun epop3-parse-po:user@host (po:user@host) "Dissect PO:USER@HOST into USER and HOST strings." (let (user host) (unless (string-match "^po:\\([^@]*\\)@\\([^:].*\\)$" po:user@host) (throw 'exit nil)) (setq user (substring po:user@host (match-beginning 1) (match-end 1)) host (substring po:user@host (match-beginning 2) (match-end 2))) (values user host))) (defun epop3-strip-through-semicolon (string) "Remove leading characters in STRING through ':' ." (car (last (string-split ":" string)))) (defun epop3-open-server (host port &optional verbose) "Open a POP3 connection to HOST on PORT, and be optionally VERBOSE." (when verbose (message (format "opening connection to %s..." host))) (with-timeout (epop3-open-server-timeout (error (format "timeout on opening %s..." host))) (pop3-open-server host pop3-port))) (defun epop3-login (process user host &optional quietly) "Perform a pop3 login using PROCESS for USER@HOST. Do so QUIETLY if asked to." (let ((user@host (concat user "@" host))) (epop3-set-authentication-scheme user@host) (epop3-set-password user@host) (case pop3-authentication-scheme (apop (unless quietly (message "apop...")) (pop3-apop process user)) (pass (unless quietly (message "user...")) (pop3-user process user) (unless quietly (message "pass...")) (pop3-pass process)) (otherwise (error "Invalid POP3 authentication scheme"))))) (defun epop3-set-authentication-scheme (user@host) "Determine the pop3 authentication scheme for USER@HOST. If we are caching passwords, get it from the hash table, otherwise prompt." (setq pop3-authentication-scheme (case epop3-password-style (cache (epop3-get-cached-authentication-scheme user@host)) (otherwise (epop3-prompt-authentication-scheme user@host))))) (defun epop3-get-cached-authentication-scheme (user@host) "Get the pop3 authentication scheme from the hash table for USER@HOST. If not there, prompt for it, save it, then return it." (let ((key user@host) (existing-entry (gethash user@host epop3-ptab))) (cond ((null existing-entry) (puthash key (make-epop3-password-entry :user@host key) epop3-ptab) (puthash key (make-epop3-host-entry :user@host key) epop3-htab) (prog1 ;; prog1 is ugly but whatcha gonna do? gotta do it... (setf (epop3-password-entry-authentication (gethash key epop3-ptab)) ;; 0.9.4 (if epop3-authentication-always-use-default epop3-authentication-default (epop3-prompt-authentication-scheme key))) (setf (epop3-password-entry-password (gethash key epop3-ptab)) (epop3-prompt-password key)))) (t (epop3-password-entry-authentication existing-entry))))) (defun epop3-prompt-authentication-scheme (user@host) "Interactively get the pop3 authentication scheme for USER@HOST." (let ((cursor-in-echo-area t) (done nil) (res nil) (prompt (format "authentication for %s? 1 = PASS, 2 = APOP? " user@host))) (with-timeout (epop3-authentication-timeout-seconds epop3-authentication-default) (while (not done) (message prompt) (case (event-basic-type (read-event)) (?1 (setq done t res 'pass)) (?2 (setq done t res 'apop)) ('return (setq done t res epop3-authentication-default)))) (discard-input) res))) (defun epop3-set-password (user@host) "Determine the pop3 password for USER@HOST, prompting if needed." ;; if pop3-password is nil, then the pop3.el library will do the prompting (setq pop3-password (case epop3-password-style (cache (epop3-get-cached-password user@host)) (otherwise nil)))) (defun epop3-get-cached-password (user@host) "Get the pop3 password from cache for USER@HOST. If not there, prompt for it, save it, then return it." (let ((key user@host) (existing-entry (gethash user@host epop3-ptab))) (cond ((null existing-entry) (puthash key (make-epop3-password-entry :user@host key) epop3-ptab) (setf (epop3-password-entry-authentication (gethash key epop3-ptab)) (epop3-prompt-authentication-scheme key)) (setf (epop3-password-entry-password (gethash key epop3-ptab)) (epop3-prompt-password key))) (t (epop3-password-entry-password existing-entry))))) (defun epop3-prompt-password (user@host) "Prompt user for USER@HOST's password." (discard-input) (pop3-read-passwd (format "Password for %s: " user@host))) (defun epop3-append-message-to-file (frombuf file hostname) "Append the incoming message from FROMBUF to FILE. FILE gets HOSTNAME tacked on to its name." (save-excursion (set-buffer frombuf) ;; some mailers have leading newlines which really screw things up ;; later. nuke 'em. (epop3-delete-leading-newlines) (epop3-insert-from-heading-if-needed hostname) ;; thanks to Jack Vinson for ;; ensure-final-newline for Gnusen users (epop3-ensure-final-newline) ;; get rid of that 'wrote file' message in echo area... ;; thanks to Sam Rushing for ;; the coding-system-for-write code (for Emacs v 20.2) (let ((coding-system-for-write 'undecided-unix)) (write-region (point-min) (point-max) file t 4 nil)))) ;; JMV 1998.08.06 (defun epop3-ensure-final-newline () ;; jvinson "Make sure that there is a final newline in the message. If not, add it. This is an attempt to fix a problem with Gnus reading mail." (save-excursion (goto-char (point-max)) (forward-line -1) (unless (looking-at "\n") (forward-line 1) (insert "\n")))) (defun epop3-delete-leading-newlines () "Delete all leading empty lines from a buffer." (save-excursion (goto-char (point-min)) (while (looking-at "^\n") (replace-match "" nil nil)))) (defun epop3-insert-from-heading-if-needed (host) "Insert a dummy 'From: HOST' heading if it's needed." (save-excursion (goto-char (point-min)) (unless (looking-at epop3-unix-mail-delimiter) ;; insert a "From " if necessary. (insert (concat "From popmail@" host " " (current-time-string) "\n"))))) (defun epop3-clear-buffer (buffer) "Erase the specified BUFFER." (save-excursion (set-buffer buffer) (setq buffer-read-only nil) (erase-buffer))) (defun epop3-update-uid-header-fields-from-buffer (buf msgno) "Extract header fields from BUF for message # MSGNO & update uid hashtab." (let* ((fields (epop3-extract-fields buf)) (this-uid (epop3-msgno-2-uidl msgno)) (rec (gethash this-uid epop3-utab))) (setf (epop3-uid-entry-from rec) (cadr (assoc 'from fields)) (epop3-uid-entry-date rec) (cadr (assoc 'date fields)) (epop3-uid-entry-subj rec) (cadr (assoc 'subj fields))))) (defun epop3-extract-fields (buf) "Extracts fields from BUF." (save-excursion (set-buffer buf) (goto-char (point-min)) (let (DATE FROM SUBJECT) (setq DATE (epop3-extract-date)) (setq FROM (epop3-extract-from)) (goto-char (point-min)) (setq SUBJECT (epop3-extract-subject)) (list (list 'from FROM) (list 'date DATE) (list 'subj SUBJECT))))) (defun epop3-extract-date () "Extract the date from RFC822 headers." ;; scarfed from rmailsum.el (save-excursion (goto-char (point-min)) (if (not (re-search-forward "^Date:" nil t)) "" (cond ((re-search-forward "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- \t_]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)" (save-excursion (end-of-line) (point)) t) (format "%2d-%3s" (string-to-int (buffer-substring (match-beginning 2) (match-end 2))) (buffer-substring (match-beginning 4) (match-end 4)))) ((re-search-forward "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z \t_]*\\)\\([0-9][0-9]?\\)" (save-excursion (end-of-line) (point)) t) (format "%2d-%3s" (string-to-int (buffer-substring (match-beginning 4) (match-end 4))) (buffer-substring (match-beginning 2) (match-end 2)))) ((re-search-forward "\\(19\\|20\\)\\([0-9][0-9]\\)-\\([01][0-9]\\)-\\([0-3][0-9]\\)" (save-excursion (end-of-line) (point)) t) (format "%2s%2s%2s" (buffer-substring (match-beginning 2) (match-end 2)) (buffer-substring (match-beginning 3) (match-end 3)) (buffer-substring (match-beginning 4) (match-end 4)))) (t "??????"))))) (defun epop3-extract-from () "Extract the 'from' from RFC822 headers." ;; scarfed from rmailsum.el (save-excursion (goto-char (point-min)) (if (not (re-search-forward "^From:[ \t]*" nil t)) "" (let* ((from (mail-strip-quoted-names (buffer-substring (1- (point)) ;; Get all the lines of the From field ;; so that we get a whole comment if there is one, ;; so that mail-strip-quoted-names can discard it. (let ((opoint (point))) (while (progn (forward-line 1) (looking-at "[ \t]"))) ;; Back up over newline, then trailing spaces or tabs (forward-char -1) (skip-chars-backward " \t") (point))))) len mch lo) (if (string-match (concat "^\\(" (regexp-quote (user-login-name)) "\\($\\|@\\)\\|" (regexp-quote ;; Don't lose if run from init file ;; where user-mail-address is not ;; set yet. (or user-mail-address (concat (user-login-name) "@" (or mail-host-address (system-name))))) "\\>\\)") from) (save-excursion (goto-char (point-min)) (if (not (re-search-forward "^To:[ \t]*" nil t)) nil (setq from (concat "to:" (mail-strip-quoted-names (buffer-substring (point) (progn (end-of-line) (skip-chars-backward " \t") (point))))))))) ;; we only want to return the first to: in the list if it's comma ;; delimited!!! (substring from 0 (string-match "," from)))))) (defun epop3-extract-subject () "Extract the subject from RFC822 headers." ;; scarfed from rmailsum.el (save-excursion (goto-char (point-min)) (if (re-search-forward "^Subject:" nil t) (progn (skip-chars-forward " \t") (buffer-substring (point) (progn (end-of-line) (point)))) (re-search-forward "[\n][\n]+" nil t) (buffer-substring (point) (progn (end-of-line) (point)))))) (defun epop3-strip-to-space-if-any (str) "Remove the space after 'to: ' in string STR, if such a space is there." (interactive "s") (let ((spc (string-match " " str))) (if spc (concat (substring str 0 spc) (substring str (1+ spc))) str))) (defun epop3-rmail-getsumline (&optional n) "When in rmail-mode, get the Summary-line: for current message. If N is given, get the Summary-line: for message number N." (interactive) (let ((msgno (or n rmail-current-message))) (save-excursion (save-restriction (widen) (goto-char (rmail-msgbeg msgno)) (re-search-forward "Summary-line: \\(.*\\)\n") (buffer-substring (match-beginning 1) (match-end 1)))))) (defun epop3-rmail-summary-getsumline (&optional n) "When in rmail-summary mode, get the Summary-line: for current message. If N is given, get the Summary-line: for message number N." (interactive) (save-excursion (set-buffer rmail-buffer) (epop3-rmail-getsumline n))) ;;; }}} ;;;-------------------------------------------------------------------------- ;; For some people, `pop3-read-process' is broken if an error occurs at ;; the server, so that C-g sometimes doesn't break out. this replacement ;; is an attempt to alleviate that problem. ;; ;; override pop3.el's version. ;;-------------------------------------------------------------------------- ;;; {{{ patched pop3-read-response (when epop3-override-pop3s-read-response (defun pop3-read-response (process &optional return) "Read the response from the server. Return the response string if optional second argument is non-nil." (let ((case-fold-search nil) match-end) (save-excursion (set-buffer (process-buffer process)) (goto-char pop3-read-point) ;; if the server is not responding for some reason, we need a way ;; to break out of this loop! ;; >>>>>>>> begin modifications <<<<<<<<<<<< (while (not (search-forward "\r\n" nil t)) (accept-process-output process 3) (goto-char pop3-read-point) (when (input-pending-p) (pop3-quit process) (error "Interrupted pop3-read-response!"))) ;; >>>>>>>> end modifications <<<<<<<<<<<< (setq match-end (point)) (goto-char pop3-read-point) (if (looking-at "-ERR") (error (buffer-substring (point) (- match-end 2))) (if (not (looking-at "+OK")) (progn (setq pop3-read-point match-end) nil) (setq pop3-read-point match-end) (if return (buffer-substring (point) match-end) t))))))) ;;; }}} ;;--------------------------------------------------------------------------- ;; Fix rmail by redefining `rmail-insert-inbox-text' ;; OR: adjust for Gnus usage... ;;-------------------------------------------------------------------------- ;;; {{{ patched 'rmail-insert-inbox-text' (case epop3-mail-package (rmail (cond ((= emacs-major-version 20) (load "epop3-riit20")) (t (load "epop3-riit19")))) ;; jvinson... (gnus (setq nnmail-movemail-program 'epop3-mail nnmail-pop-password-required nil))) ;;; }}} ;;; {{{ submitting bug reports -- made easier (defun epop3-submit-bug-report () "Submit via mail a bug report on epop3mail." (interactive) (require 'reporter) ;; load in reporter (let ((reporter-prompt-for-summary-p t)) (and (if (y-or-n-p "Do you want to submit a report on epop3mail? ") t (message "") nil) (require 'reporter) (reporter-submit-bug-report epop3-mail-help-address (concat "epop3mail " epop3-mail-version " ") (let ((vars (list 'epop3-authentication-always-use-default 'epop3-authentication-default 'epop3-authentication-timeout-seconds 'epop3-biff-absolutely-silent 'epop3-biff-debug 'epop3-biff-differential-mode 'epop3-biff-ding 'epop3-biff-hook 'epop3-biff-idle-grace-seconds 'epop3-biff-interval 'epop3-biff-linear-bark-mode 'epop3-biff-show-barks 'epop3-biff-show-mail-string 'epop3-biff-show-numbers 'epop3-biff-show-off-vocabulary 'epop3-biff-optimize-if-possible 'epop3-biff-optimized-and-read 'epop3-biff-show-progress 'epop3-biff-show-snooze 'epop3-biff-show-time 'epop3-biffed-at-least-once 'epop3-biffing 'epop3-current-bark 'epop3-last-biff-at 'epop3-leave-mail-on-server 'epop3-mail-debug 'epop3-mail-package 'epop3-mailbox-list 'epop3-manage-debug 'epop3-manage-really-delete 'epop3-mode-line-info 'epop3-old-n 'epop3-open-server-timeout 'epop3-override-pop3s-read-response 'epop3-password-style 'epop3-quietly 'epop3-unix-mail-delimiter ))) (if (not (boundp 'defun-prompt-regexp)) (delq 'defun-prompt-regexp vars) vars)) nil nil "Dear Franklin," )))) ;;; }}} (provide 'epop3mail) ;;; }}} ;;; epop3mail.el ends here