X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fpop3-fma.el;h=293efe6a727831e215920302f45cb1978bf5c276;hb=993f1e33613c4a616fcb472358f430bb5f33665e;hp=5569687b6026350c072bc453a47de8ad3317081c;hpb=573be2afefdd53afe43b8f128c4227b2f411b81f;p=elisp%2Fgnus.git-

diff --git a/lisp/pop3-fma.el b/lisp/pop3-fma.el
index 5569687..293efe6 100644
--- a/lisp/pop3-fma.el
+++ b/lisp/pop3-fma.el
@@ -1,7 +1,9 @@
 ;; pop3-fma.el.el --- POP3 for Multiple Account for Gnus.
 ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. , Tatsuya Ichikawa
+;;                                                           Yasuo Okabe
 ;; Author: Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
-;; Version: 0.12
+;;         Yasuo OKABE <okabe@kuis.kyoto-u.ac.jp>
+;; Version: 1.16
 ;; Keywords: mail , gnus , pop3
 ;;
 ;; SPECIAL THANKS
@@ -27,21 +29,30 @@
 
 ;;; Commentary:
 ;;
+;; Note.
+;;
+;; This file store pop3 password in variable "pop3-fma-password".
+;; Please take care by yourself to treat pop3 password.
 ;;
 ;; How to use.
 ;;
 ;; add your .emacs following codes.
 ;;
-;;  (autoload 'pop3-fma-set-pop3-password "pop3-fma")
-;;  (add-hook 'gnus-load-hook 'pop3-fma-set-pop3-password)
+;;  (require 'pop3-fma)
 ;;  (setq pop3-fma-spool-file-alist
 ;;        '(
-;;  	    "po:username0@mailhost0.your.domain0"
-;;	    "po:username1@mailhost1.your.domain1"
+;;  	    ("po:username0@mailhost0.your.domain0" pass)
+;;	    ("po:username1@mailhost1.your.domain1" apop)
 ;;                         :
 ;;                         :
 ;;	   ))
 ;;
+;;	pass means normal authentication USER/PASS.
+;;	apop means authentication using APOP.
+;;
+;; When using apop , Please set pop3-fma-movemail-type 'lisp.
+;; movemail.exe does not work on APOP protocol.
+;;
 ;; Variables
 ;;
 ;;  pop3-fma-spool-file-alist      ... Spool file alist of POP3 protocol
@@ -73,33 +84,33 @@
   :group 'mail
   :group 'news)
 
-(defconst pop3-fma-version-number "0.12")
+(defconst pop3-fma-version-number "1.16")
 (defconst pop3-fma-codename
-;;;  "Feel the wind"		; 0.10
-;;  "My home town"  		; 0.11
-  "On the road"			; 0.12
-;;  "Before generation of Love"	; 0.xx
-;;  "Lonely Christmas eve"	; 0.xx
-;;  "Rock'n Roll city"		; 0.xx
-;;  "Money"			; 0.xx
-;;  "Midnight blue train" 	; 0.xx
-;;  "Still 19"       		; 0.xx
-;;  "J boy"          		; 0.xx
-;;  "Blood line"		; 0.xx
-;;  "Star ring"			; 0.xx
-;;  "Goodbye Game"		; 0.xx
+;;  "J boy"          		; 1.00
+;;  "Blood line"		; 1.10
+;;  "Star ring"			; 1.11
+;;  "Goodbye Game"		; 1.12
+;;  "Love is Gamble"		; 1.13
+;;  "Lonely"			; 1.14
+  "Feel the wind"		; 1.16
   )
 (defconst pop3-fma-version (format "Multiple POP3 account utiliy for Gnus v%s - \"%s\""
 				       pop3-fma-version-number
 				       pop3-fma-codename))
 
 (defcustom pop3-fma-spool-file-alist nil
-  "*Spoolfile to get mail using pop3 protocol.
+  "*Spool file to get mail using pop3 protocol.
 You should specify this variable like
  '(
-   \"po:user1@mailhost1\"
-   \"po:user2@mailhost2\"
-  )"
+   (\"po:user1@mailhost1\" type)
+   (\"po:user2@mailhost2\" type)
+  )
+Type must be pass or apop."
+  :group 'pop3-fma
+  :type 'alist)
+
+(defcustom pop3-fma-local-spool-file-alist nil
+  "*List of Local spool file to get mail."
   :group 'pop3-fma
   :type 'alist)
 
@@ -117,66 +128,147 @@ Lisp means `nnmail-movemail-program' is lisp function.
   :group 'pop3-fma
   :type '(repeat (string :tag "Argument")))
 
+(defcustom pop3-fma-save-password-information nil
+  "*If non nil , save POP Server's password information.
+============== Important notice =====================
+Please take care of your password information.
+If set to t , your pop3 password is saved in pop3-fma-password in raw text.
+So , Anybody can see this information by describe-variable.
+If there is any problem , please set this variable to nil(default).
+============== Important notice ====================="
+  :group 'pop3-fma
+  :type 'boolean)
+
 ;;; Internal variables.
 (defvar pop3-fma-password nil
   "*POP3 password , user , mailhost information for Gnus.")
 
-(defvar pop3-fma-movemail-program "movemail.exe"
-  "*External program name your movemail.
-Please do not set this valiable non-nil if you do not use Meadow.")
+(defvar pop3-fma-movemail-program
+  (if (eq system-type 'windows-nt)
+      "movemail.exe"
+    "movemail")
+  "*External program name your movemail.")
+
 
 ;; Temporary variable
 (defvar hdr nil)
 (defvar passwd nil)
 (defvar str nil)
-(defvar pop3-fma-movemail-options pop3-fma-movemail-arguments)
+(defvar spool nil)
+(defvar movemail-output-buffer " *movemail-out*")
+(defvar pop3-fma-commandline-arguments nil)
+
+;;; To silence byte compiler
+(and
+ (fboundp 'eval-when-compile)
+ (eval-when-compile
+   (save-excursion
+     (beginning-of-defun)
+     (eval-region (point-min) (point)))
+   (let (case-fold-search)
+     (mapcar
+      (function
+       (lambda (symbol)
+	 (unless (boundp symbol)
+	   (make-local-variable symbol)
+	   (eval (list 'setq symbol nil)))))
+      '(:group
+	:prefix :type
+	pop3-maildrop
+	pop3-mailhost
+	))
+     (make-local-variable 'byte-compile-warnings)
+     (setq byte-compile-warnings nil))))
 
-(defun pop3-fma-init-hooks ()
+(defun pop3-fma-init-message-hook ()
   (add-hook 'message-send-hook 'pop3-fma-message-add-header))
 
 (eval-after-load "message"
-  '(pop3-fma-init-hooks))
+  '(pop3-fma-init-message-hook))
+
+(add-hook 'gnus-after-exiting-gnus-hook
+	  '(lambda () (setq pop3-fma-password nil)))
+(add-hook 'gnus-before-startup-hook 'pop3-fma-set-pop3-password)
+
 ;;
 ;;
 ;; Gnus POP3 additional utility...
 ;;
 (defun pop3-fma-movemail (inbox crashbox)
   "Function to move mail from INBOX on a pop3 server to file CRASHBOX."
-  (let ((pop3-maildrop
-	 (substring inbox (match-end (string-match "^po:" inbox))
-		    (- (match-end (string-match "^.*@" inbox)) 1)))
-	(pop3-mailhost
-	 (substring inbox (match-end (string-match "^.*@" inbox)))))
-    (let ((pop3-password
-	   (pop3-fma-read-passwd pop3-mailhost)))
-      (message "Checking new mail user %s at %s..." pop3-maildrop pop3-mailhost)
-      (if (and (eq system-type 'windows-nt)
-	       (eq pop3-fma-movemail-type 'exe))
-	  (progn
-	    (setenv "MAILHOST" pop3-mailhost)
-	    (if (and (not (memq pop3-password pop3-fma-movemail-arguments))
-		     (not (memq (concat "po:" pop3-maildrop) pop3-fma-movemail-arguments)))
-		(progn
-		  (setq pop3-fma-movemail-arguments nil)
-		  (setq pop3-fma-movemail-arguments
-		      (append pop3-fma-movemail-options
-			      (list
-			       (concat "po:" pop3-maildrop)
-			       crashbox
-			       pop3-password)))))
-	    (apply 'call-process (concat
-				  exec-directory
-				  pop3-fma-movemail-program)
-		   nil nil nil
-		   pop3-fma-movemail-arguments))
-	(pop3-movemail crashbox)))))
+  (if (string-match "^po:" inbox)
+      (progn
+	(let ((pop3-maildrop
+	       (substring inbox (match-end (string-match "^po:" inbox))
+			  (- (match-end (string-match "^.*@" inbox)) 1)))
+	      (pop3-mailhost
+	       (substring inbox (match-end (string-match "^.*@" inbox))))
+	      (pop3-password
+	       (if pop3-fma-save-password-information
+		   (pop3-fma-read-passwd (substring inbox (match-end (string-match "^.*@" inbox))))
+		 (pop3-fma-input-password
+		  (substring inbox (match-end (string-match "^.*@" inbox)))
+		  (substring inbox (match-end (string-match "^po:" inbox))
+			     (- (match-end (string-match "^.*@" inbox)) 1)))))
+	      (pop3-authentication-scheme
+	       (nth 1 (assoc inbox pop3-fma-spool-file-alist)))
+	      (pop3-fma-movemail-type (pop3-fma-get-movemail-type inbox)))
+	  (if (eq pop3-authentication-scheme 'pass)
+	      (message "Checking new mail user %s at %s using USER/PASS ..." pop3-maildrop pop3-mailhost)
+	    (message "Checking new mail user %s at %s using APOP ..." pop3-maildrop pop3-mailhost))
+	  (if (and (eq system-type 'windows-nt)
+		   (eq pop3-fma-movemail-type 'exe))
+	      (progn
+		(setenv "MAILHOST" pop3-mailhost)
+		(if (and (not (memq pop3-password pop3-fma-commandline-arguments))
+			 (not (memq (concat "po:" pop3-maildrop) pop3-fma-commandline-arguments)))
+		    (progn
+		      (setq pop3-fma-commandline-arguments
+			    (append
+			     pop3-fma-movemail-arguments
+				    (list
+				     (concat "po:" pop3-maildrop)
+				     crashbox
+				     pop3-password)))))
+		(if (not (get-buffer movemail-output-buffer))
+		    (get-buffer-create movemail-output-buffer))
+		(set-buffer movemail-output-buffer)
+		(erase-buffer)
+		(apply 'call-process (concat
+				      exec-directory
+				      pop3-fma-movemail-program)
+		       nil movemail-output-buffer nil
+		       pop3-fma-commandline-arguments)
+		(let ((string (buffer-string)))
+		  (if (> (length string) 0)
+		      (progn
+			(if (y-or-n-p
+			     (concat (substring string 0
+						(- (length string) 1))
+						" continue ??"))
+			    nil
+			  nil)))))
+	    (pop3-movemail crashbox))))
+    (message "Checking new mail at %s ... " inbox)
+    (call-process (concat exec-directory pop3-fma-movemail-program)
+		  nil
+		  nil
+		  nil
+		  inbox
+		  crashbox)
+    (message "Checking new mail at %s ... done." inbox)))
 ;;
 ;;
 (defun pop3-fma-read-passwd (mailhost)
   (setq passwd (nth 2 (assoc mailhost pop3-fma-password)))
   passwd)
 
-(setq pop3-read-passwd 'pop3-fma-read-passwd)
+(defun pop3-fma-input-password (mailhost maildrop)
+  (pop3-fma-read-noecho
+   (format "POP Password for %s at %s: " maildrop mailhost) t))
+
+(setq pop3-read-passwd 'pop3-fma-read-passwd
+      nnmail-read-passwd 'pop3-fma-read-passwd)
 ;;
 ;; Set multiple pop3 server's password
 (defun pop3-fma-store-password (passwd)
@@ -190,26 +282,50 @@ Please do not set this valiable non-nil if you do not use Meadow.")
 		     (list
 		      pop3-mailhost
 		      pop3-maildrop
-		      passwd))))
+		      passwd)))))
     (setcar (cdr (cdr (assoc pop3-mailhost pop3-fma-password)))
-	    passwd))
-  (message "POP password registered.")
-  passwd)
+	    passwd)
+    (message "POP password registered.")
+    passwd)
 ;;
 ;;;###autoload
 (defun pop3-fma-set-pop3-password()
   (interactive)
-  (mapcar
-   (lambda (x)
-     (let ((pop3-maildrop
-	    (substring x (match-end (string-match "^po:" x))
-		       (- (match-end (string-match "^.*@" x)) 1)))
-	   (pop3-mailhost
-	    (substring x (match-end (string-match "^.*@" x)))))
-       (call-interactively 'pop3-fma-store-password)))
-   pop3-fma-spool-file-alist)
+  (if pop3-fma-save-password-information
+      (progn
+	(mapcar
+	 (lambda (x)
+	   (let ((pop3-maildrop
+		  (substring (car x) (match-end (string-match "^po:" (car x)))
+			     (- (match-end (string-match "^.*@" (car x))) 1)))
+		 (pop3-mailhost
+		  (substring (car x) (match-end (string-match "^.*@" (car x))))))
+	     (call-interactively 'pop3-fma-store-password)))
+	 pop3-fma-spool-file-alist)))
   (setq nnmail-movemail-program 'pop3-fma-movemail)
-  (setq nnmail-spool-file pop3-fma-spool-file-alist))
+;;  (setq nnmail-spool-file pop3-fma-spool-file-alist))
+  (setq nnmail-spool-file (append
+			   pop3-fma-local-spool-file-alist
+			   (mapcar
+			    (lambda (spool)
+			      (car spool))
+			    pop3-fma-spool-file-alist))))
+;;
+(defmacro pop3-fma-read-char-exclusive ()
+  (cond ((featurep 'xemacs)
+	 '(let ((table (quote ((backspace . ?\C-h) (delete . ?\C-?)
+			       (left . ?\C-h))))
+		event key)
+	    (while (not
+		    (and
+		     (key-press-event-p (setq event (next-command-event)))
+		     (setq key (or (event-to-character event)
+				   (cdr (assq (event-key event) table)))))))
+	    key))
+	((fboundp 'read-char-exclusive)
+	 '(read-char-exclusive))
+	(t
+	 '(read-char))))
 ;;
 (defun pop3-fma-read-noecho (prompt &optional stars)
   "Read a single line of text from user without echoing, and return it.
@@ -229,15 +345,15 @@ Argument PROMPT ."
 	(and (> truncate 0)
 	     (setq msg (concat "$" (substring msg (1+ truncate))))))
       (message msg)
-      (setq c (read-char-exclusive))
-      (cond ((= c ?\C-g)
+      (setq c (pop3-fma-read-char-exclusive))
+      (cond ((eq ?\C-g c)
 	     (setq quit-flag t
 		   done t))
-	    ((or (= c ?\r) (= c ?\n) (= c ?\e))
+	    ((memq c '(?\r ?\n ?\e))
 	     (setq done t))
-	    ((= c ?\C-u)
+	    ((eq ?\C-u c)
 	     (setq ans ""))
-	    ((and (/= c ?\b) (/= c ?\177))
+	    ((and (/= ?\b c) (/= ?\177 c))
 	     (setq ans (concat ans (char-to-string c))))
 	    ((> (length ans) 0)
 	     (setq ans (substring ans 0 -1)))))
@@ -251,11 +367,11 @@ Argument PROMPT ."
 ;;
 ;;
 (defun pop3-fma-message-add-header ()
-  (pop3-fma-add-custom-header "X-Ya-Pop3:" pop3-fma-version))
+  (if (message-mail-p)
+      (pop3-fma-add-custom-header "X-Ya-Pop3:" pop3-fma-version)))
   
 ;;
 ;; Add your custom header.
-;;
 (defun pop3-fma-add-custom-header (header string)
   (let ((delimline
 	 (progn (goto-char (point-min))
@@ -273,6 +389,14 @@ Argument PROMPT ."
 	  (setq hdr (concat str "\n"))
 	  (insert-string hdr)))))
 ;;
+;;
+(defun pop3-fma-get-movemail-type (inbox)
+  (if (eq (nth 1 (assoc inbox pop3-fma-spool-file-alist)) 'apop)
+      'lisp
+    pop3-fma-movemail-type))
+;;
 (provide 'pop3-fma)
 ;;
 ;; pop3-fma.el ends here.
+
+