changeset 32918:dd8c5458b624

2000-10-26 Dave Love <fx@gnu.org> * mail-source.el: Require imap when compiling and defvar display-time-mail-function. Require mm-util. (nnheader-cancel-timer): Autoload. (mail-source-imap-authenticators, mail-source-imap-streams): New variables. (mail-sources): Use them. (defvar): Use rmail-spool-directory unconditionally. 2000-10-26 Per Abrahamsen <abraham@dina.kvl.dk> * mail-source.el (mail-sources): Better `:type'. 2000-10-26 Kai Gro?ohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * mail-source.el (mail-source-keyword-map): Use `rmail-spool-directory' as a default directory for the `file' source, if the variable is defined. Fall back to hardcoded "/usr/spool/mail/", as before. Suggestion by Steven E. Harris <seh@speakeasy.org>.
author Dave Love <fx@gnu.org>
date Thu, 26 Oct 2000 17:13:22 +0000
parents 0d78af57cddd
children 17d5f3547c87
files lisp/gnus/mail-source.el
diffstat 1 files changed, 170 insertions(+), 132 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/gnus/mail-source.el	Thu Oct 26 15:59:48 2000 +0000
+++ b/lisp/gnus/mail-source.el	Thu Oct 26 17:13:22 2000 +0000
@@ -2,6 +2,7 @@
 ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Maintainer: bugs@gnus.org
 ;; Keywords: news, mail
 
 ;; This file is part of GNU Emacs.
@@ -25,153 +26,190 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
+(eval-when-compile
+  (require 'cl)
+  (require 'imap)
+  (eval-when-compile (defvar display-time-mail-function)))
 (eval-and-compile
   (autoload 'pop3-movemail "pop3")
-  (autoload 'pop3-get-message-count "pop3"))
+  (autoload 'pop3-get-message-count "pop3")
+  (autoload 'nnheader-cancel-timer "nnheader"))
 (require 'format-spec)
+(require 'mm-util)
 
 (defgroup mail-source nil
   "The mail-fetching library."
   :version "21.1"
   :group 'gnus)
 
+;; Define these at compile time to avoid dragging in imap always.
+(defconst mail-source-imap-authenticators
+  (eval-when-compile
+    (mapcar (lambda (a)
+	      (list 'const (car a)))
+     imap-authenticator-alist)))
+(defconst mail-source-imap-streams
+  (eval-when-compile
+    (mapcar (lambda (a)
+	      (list 'const (car a)))
+     imap-stream-alist)))
+
 (defcustom mail-sources nil
   "*Where the mail backends will look for incoming mail.
 This variable is a list of mail source specifiers.
 See Info node `(gnus)Mail Source Specifiers'."
   :group 'mail-source
-  ;; This specification should be tidied up, particularly to avoid
-  ;; constant items appearing.  (Perhaps there's scope for improvment
-  ;; in the widget code.)
   :type `(repeat
-	  (choice (const :tag "Default spool file" (file))
-		  (list :tag "Specified spool file"
-			(const file)
-			(const :value :path)
-			file)
+	  (choice :format "%[Value Menu%] %v"
+		  :value (file)
+		  (cons :tag "Spool file"
+			(const :format "" file)
+			(checklist :tag "Options" :greedy t
+				   (group :inline t
+					  (const :format "" :value :path)
+					  file)))
 		  (cons :tag "Several files in a directory"
-			(const directory)
-			(choice
-			 :tag "Options"
-			 (const :tag "None" nil)
-			 (repeat
-			  (choice
-			   (list :inline t :tag "path"
-				 (const :value :path) directory)
-			   (list :inline t :tag "suffix"
-				 (const :value :suffix) string)
-			   (list :inline t :tag "predicate"
-				 (const :value :predicate) function)
-			   (list :inline t :tag "prescript"
-				 (const :value :prescript) string)
-			   (list :inline t :tag "postscript"
-				 (const :value :postscript) string)
-			   (list :inline t :tag "plugged"
-				 (const :value :plugged) boolean)))))
+			(const :format "" directory)
+			(checklist :tag "Options" :greedy t
+				   (group :inline t
+					  (const :format "" :value :path)
+					  (directory :tag "Path"))
+				   (group :inline t
+					  (const :format "" :value :suffix)
+					  (string :tag "Suffix"))
+				   (group :inline t
+					  (const :format "" :value :predicate)
+					  (function :tag "Predicate"))
+				   (group :inline t
+					  (const :format "" :value :prescript)
+					  (string :tag "Prescript"))
+				   (group :inline t
+					  (const :format "" :value :postscript)
+					  (string :tag "Postscript"))
+				   (group :inline t
+					  (const :format "" :value :plugged)
+					  (boolean :tag "Plugged"))))
 		  (cons :tag "POP3 server"
-			(const pop)
-			(choice
-			 :tag "Options"
-			 (const :tag "None" nil)
-			 (repeat
-			  (choice
-			   (list :inline t :tag "server"
-				 (const :value :server) string)
-			   (list :inline t :tag "port"
-				 (const :value :port) (choice number string))
-			   (list :inline t :tag "user"
-				 (const :value :user) string)
-			   (list :inline t :tag "password"
-				 (const :value :password) string)
-			   (list :inline t :tag "program"
-				 (const :value :program) string)
-			   (list :inline t :tag "prescript"
-				 (const :value :prescript) string)
-			   (list :inline t :tag "postscript"
-				 (const :value :postscript) string)
-			   (list :inline t :tag "function"
-				 (const :value :function) function)
-			   (list :inline t :tag "authentication"
-				 (const :value :authentication)
-				 (choice (const password)
-					 (const apop)))
-			   (list :inline t :tag "plugged"
-				 (const :value :plugged) boolean)))))
+			(const :format "" pop)
+			(checklist :tag "Options" :greedy t
+				   (group :inline t
+					  (const :format "" :value :server) 
+					  (string :tag "Server"))
+				   (group :inline t
+					  (const :format "" :value :port) 
+					  (choice :tag "Port"
+						  :value "pop3" 
+						  (number :format "%v")
+						  (string :format "%v")))
+				   (group :inline t
+					  (const :format "" :value :user)
+					  (string :tag "User"))
+				   (group :inline t
+					  (const :format "" :value :password)
+					  (string :tag "Password"))
+				   (group :inline t
+					  (const :format "" :value :program)
+					  (string :tag "Program"))
+				   (group :inline t
+					  (const :format "" :value :prescript)
+					  (string :tag "Prescript"))
+				   (group :inline t
+					  (const :format "" :value :postscript)
+					  (string :tag "Postscript"))
+				   (group :inline t
+					  (const :format "" :value :function)
+					  (function :tag "Function"))
+				   (group :inline t
+					  (const :format "" 
+						 :value :authentication)
+					  (choice :tag "Authentication"
+						  :value apop
+						  (const password)
+						  (const apop)))
+				   (group :inline t
+					  (const :format "" :value :plugged)
+					  (boolean :tag "Plugged"))))
 		  (cons :tag "Maildir (qmail, postfix...)"
-			(const maildir)
-			(choice
-			 :tag "Options"
-			 (const :tag "None" nil)
-			 (repeat
-			  (choice
-			   (list :inline t :tag "path"
-				 (const :value :path) directory)
-			   (list :inline t :tag "plugged"
-				 (const :value :plugged) boolean)))))
+			(const :format "" maildir)
+			(checklist :tag "Options" :greedy t
+				   (group :inline t
+					  (const :format "" :value :path)
+					  (directory :tag "Path"))
+				   (group :inline t
+					  (const :format "" :value :plugged)
+					  (boolean :tag "Plugged"))))
 		  (cons :tag "IMAP server"
-			(const imap)
-			(choice
-			 :tag "Options"
-			 (const :tag "None" nil)
-			 (repeat
-			  (choice
-			   (list :inline t :tag "server"
-				 (const :value :server) string)
-			   (list :inline t :tag "port"
-				 (const :value :port)
-				 (choice number string))
-			   (list :inline t :tag "user"
-				 (const :value :user) string)
-			   (list :inline t :tag "password"
-				 (const :value :password) string)
-			   (list :inline t :tag "stream"
-				 (const :value :stream)
-				 (choice ,@(progn (require 'imap)
-						  (mapcar
-						   (lambda (a)
-						     (list 'const (car a)))
-						   imap-stream-alist))))
-			   (list :inline t :tag "authenticator"
-				 (const :value :authenticator)
-				 (choice ,@(progn (require 'imap)
-						  (mapcar
-						   (lambda (a)
-						     (list 'const (car a)))
-						   imap-authenticator-alist))))
-			   (list :inline t :tag "mailbox"
-				 (const :value :mailbox) string)
-			   (list :inline t :tag "predicate"
-				 (const :value :predicate) function)
-			   (list :inline t :tag "fetchflag"
-				 (const :value :fetchflag) string)
-			   (list :inline t :tag "dontexpunge"
-				 (const :value :dontexpunge) boolean)
-			   (list :inline t :tag "plugged"
-				 (const :value :plugged) )))))
+			(const :format "" imap)
+			(checklist :tag "Options" :greedy t
+				   (group :inline t
+					  (const :format "" :value :server)
+					  (string :tag "Server"))
+				   (group :inline t
+					  (const :format "" :value :port)
+					  (choice :tag "Port" 
+						  :value 143 
+						  number string))
+				   (group :inline t
+					  (const :format "" :value :user)
+					  (string :tag "User"))
+				   (group :inline t
+					  (const :format "" :value :password)
+					  (string :tag "Password"))
+				   (group :inline t
+					  (const :format "" :value :stream)
+					  (choice :tag "Stream"
+						  :value network
+						  ,@mail-source-imap-streams))
+				   (group :inline t
+					  (const :format ""
+						 :value :authenticator)
+					  (choice :tag "Authenticator"
+						  :value login
+						  ,@mail-source-imap-authenticators))
+				   (group :inline t
+					  (const :format "" :value :mailbox)
+					  (string :tag "Mailbox"))
+				   (group :inline t
+					  (const :format "" :value :predicate)
+					  (function :tag "Predicate"))
+				   (group :inline t
+					  (const :format "" :value :fetchflag)
+					  (string :tag "Fetchflag"))
+				   (group :inline t
+					  (const :format ""
+						 :value :dontexpunge)
+					  (boolean :tag "Dontexpunge"))
+				   (group :inline t
+					  (const :format "" :value :plugged)
+					  (boolean :tag "Plugged"))))
 		  (cons :tag "Webmail server"
-			(const webmail)
-			(choice
-			 :tag "Options"
-			 (const :tag "None" nil)
-			 (repeat
-			  (choice
-			   (list :inline t :tag "subtype"
-				 (const :value :subtype)
-				 ;; Should be generated from
-				 ;; `webmail-type-definition', but we
-				 ;; can't require webmail without W3.
-				 (choice (const hotmail) (const yahoo)
-					 (const netaddress) (const netscape)
-					 (const my-deja)))
-			   (list :inline t :tag "user"
-				 (const :value :user) string)
-			   (list :inline t :tag "password"
-				 (const :value :password) string)
-			   (list :inline t :tag "dontexpunge"
-				 (const :value :dontexpunge) boolean)
-			   (list :inline t :tag "plugged"
-				 (const :value :plugged) boolean))))))))
+			(const :format "" webmail)
+			(checklist :tag "Options" :greedy t
+				   (group :inline t 
+					 (const :format "" :value :subtype)
+					 ;; Should be generated from
+					 ;; `webmail-type-definition', but we
+					 ;; can't require webmail without W3.
+					 (choice :tag "Subtype"
+						 :value hotmail
+						 (const hotmail)
+						 (const yahoo)
+						 (const netaddress)
+						 (const netscape)
+						 (const my-deja)))
+				   (group :inline t
+					  (const :format "" :value :user)
+					  (string :tag "User"))
+				   (group :inline t
+					  (const :format "" :value :password)
+					  (string :tag "Password"))
+				   (group :inline t
+					  (const :format ""
+						 :value :dontexpunge)
+					  (boolean :tag "Dontexpunge"))
+				   (group :inline t
+					  (const :format "" :value :plugged)
+					  (boolean :tag "Plugged")))))))
 
 (defcustom mail-source-primary-source nil
   "*Primary source for incoming mail.
@@ -234,7 +272,7 @@
        (:prescript-delay)
        (:postscript)
        (:path (or (getenv "MAIL")
-		  (concat "/usr/spool/mail/" (user-login-name)))))
+		  (expand-file-name (user-login-name) rmail-spool-directory))))
       (directory
        (:path)
        (:suffix ".spool")
@@ -811,12 +849,12 @@
 		user (or (cdr (assoc from mail-source-password-cache))
 			 password) buf)
 	       (imap-mailbox-select mailbox nil buf))
-	  (let ((coding-system-for-write mail-source-imap-file-coding-system) 
-		;; Avoid converting 8-bit chars from inserted strings to
-		;; multibyte.
-		default-enable-multibyte-characters
+	  (let ((coding-system-for-write mail-source-imap-file-coding-system)
 		str)
 	    (with-temp-file mail-source-crash-box
+	      ;; Avoid converting 8-bit chars from inserted strings to
+	      ;; multibyte.
+	      (mm-disable-multibyte)
 	      ;; remember password
 	      (with-current-buffer buf
 		(when (or imap-password