1 ;; pop3-fma.el.el --- POP3 for Multiple Account for Gnus.
2 ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. , Tatsuya Ichikawa
4 ;; Author: Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
5 ;; Yasuo OKABE <okabe@kuis.kyoto-u.ac.jp>
7 ;; Keywords: mail , gnus , pop3
10 ;; Keiichi Suzuki <kei-suzu@mail.wbs.or.jp>
11 ;; Katsumi Yamaoka <yamaoka@jpl.org>
13 ;; This file is not part of GNU Emacs.
15 ;; GNU Emacs is free software; you can redistribute it and/or modify
16 ;; it under the terms of the GNU General Public License as published by
17 ;; the Free Software Foundation; either version 2, or (at your option)
20 ;; GNU Emacs is distributed in the hope that it will be useful,
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;; GNU General Public License for more details.
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with GNU Emacs; see the file COPYING. If not, write to the
27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
28 ;; Boston, MA 02111-1307, USA.
34 ;; This file store pop3 password in variable "pop3-fma-password".
35 ;; Please take care by yourself to treat pop3 password.
39 ;; add your .emacs following codes.
41 ;; (require 'pop3-fma)
42 ;; (setq pop3-fma-spool-file-alist
44 ;; ("po:username0@mailhost0.your.domain0" pass)
45 ;; ("po:username1@mailhost1.your.domain1" apop)
50 ;; pass means normal authentication USER/PASS.
51 ;; apop means authentication using APOP.
55 ;; pop3-fma-spool-file-alist ... Spool file alist of POP3 protocol
56 ;; pop3-fma-movemail-type ... Type of movemail program.
60 ;; pop3-fma-movemail-arguments ... List of options of movemail program.
67 (unless (and (condition-case ()
73 (defmacro defgroup (&rest args))
74 (defmacro defcustom (symbol value &optional doc &rest args)
75 (` (defvar (, symbol) (, value) (, doc))))
78 (defgroup pop3-fma nil
79 "Multile POP3 account utility for Gnus."
84 (defconst pop3-fma-version-number "1.16")
85 (defconst pop3-fma-codename
87 ;; "Blood line" ; 1.10
89 ;; "Goodbye Game" ; 1.12
90 ;; "Love is Gamble" ; 1.13
92 ;; "Feel the wind" ; 1.16
93 "Sadness like snow" ; 1.17
95 (defconst pop3-fma-version (format "Multiple POP3 account utiliy for Gnus v%s - \"%s\""
96 pop3-fma-version-number
99 (defcustom pop3-fma-spool-file-alist nil
100 "*Spool file to get mail using pop3 protocol.
101 You should specify this variable like
103 (\"po:user1@mailhost1\" type)
104 (\"po:user2@mailhost2\" type)
106 Type must be pass or apop."
110 (defcustom pop3-fma-local-spool-file-alist nil
111 "*List of Local spool file to get mail."
115 (defcustom pop3-fma-movemail-type 'lisp
116 "*Type of movemail program.
117 Lisp means `nnmail-movemail-program' is lisp function.
118 Exe means `nnmail-movemail-program' is external program."
120 :type '(choice (const lisp)
123 (defcustom pop3-fma-movemail-arguments '("-pf")
124 "*Options for movemail."
126 :type '(repeat (string :tag "Argument")))
128 (defcustom pop3-fma-save-password-information nil
129 "*If non nil , save POP Server's password information.
130 ============== Important notice =====================
131 Please take care of your password information.
132 If set to t , your pop3 password is saved in pop3-fma-password in raw text.
133 So , Anybody can see this information by describe-variable.
134 If there is any problem , please set this variable to nil(default).
135 ============== Important notice ====================="
139 ;;; Internal variables.
140 (defvar pop3-fma-password nil
141 "*POP3 password , user , mailhost information for Gnus.")
143 (defvar pop3-fma-movemail-program
144 (if (eq system-type 'windows-nt)
147 "*External program name your movemail.")
150 ;; Temporary variable
155 (defvar movemail-output-buffer " *movemail-out*")
156 (defvar pop3-fma-commandline-arguments nil)
158 ;;; To silence byte compiler
160 (fboundp 'eval-when-compile)
164 (eval-region (point-min) (point)))
165 (let (case-fold-search)
169 (unless (boundp symbol)
170 (make-local-variable symbol)
171 (eval (list 'setq symbol nil)))))
177 (make-local-variable 'byte-compile-warnings)
178 (setq byte-compile-warnings nil))))
180 (defun pop3-fma-init-message-hook ()
181 (add-hook 'message-send-hook 'pop3-fma-message-add-header))
183 (eval-after-load "message"
184 '(pop3-fma-init-message-hook))
186 (add-hook 'gnus-after-exiting-gnus-hook
187 '(lambda () (setq pop3-fma-password nil)))
188 (add-hook 'gnus-before-startup-hook 'pop3-fma-set-pop3-password)
192 ;; Gnus POP3 additional utility...
194 (defun pop3-fma-movemail (inbox crashbox)
195 "Function to move mail from INBOX on a pop3 server to file CRASHBOX."
196 (if (string-match "^po:" inbox)
199 (substring inbox (match-end (string-match "^po:" inbox))
200 (- (match-end (string-match "^.*@" inbox)) 1)))
202 (substring inbox (match-end (string-match "^.*@" inbox))))
204 (if pop3-fma-save-password-information
205 (pop3-fma-read-passwd (substring inbox (match-end (string-match "^.*@" inbox))))
206 (pop3-fma-input-password
207 (substring inbox (match-end (string-match "^.*@" inbox)))
208 (substring inbox (match-end (string-match "^po:" inbox))
209 (- (match-end (string-match "^.*@" inbox)) 1)))))
210 (pop3-authentication-scheme
211 (nth 1 (assoc inbox pop3-fma-spool-file-alist))))
212 ;; (pop3-fma-movemail-type (pop3-fma-get-movemail-type inbox)))
213 (if (eq pop3-authentication-scheme 'pass)
214 (message "Checking new mail user %s at %s using USER/PASS ..." pop3-maildrop pop3-mailhost)
215 (message "Checking new mail user %s at %s using APOP ..." pop3-maildrop pop3-mailhost))
216 (if (eq pop3-fma-movemail-type 'exe)
218 (setenv "MAILHOST" pop3-mailhost)
219 (if (and (not (memq pop3-password pop3-fma-commandline-arguments))
220 (not (memq (concat "po:" pop3-maildrop) pop3-fma-commandline-arguments)))
222 (if (eq pop3-authentication-scheme 'apop)
223 (setq pop3-fma-commandline-arguments
225 pop3-fma-movemail-arguments
228 (concat "po:" pop3-maildrop)
231 (setq pop3-fma-commandline-arguments
233 pop3-fma-movemail-arguments
235 (concat "po:" pop3-maildrop)
238 (if (not (get-buffer movemail-output-buffer))
239 (get-buffer-create movemail-output-buffer))
240 (set-buffer movemail-output-buffer)
242 (apply 'call-process (concat
244 pop3-fma-movemail-program)
245 nil movemail-output-buffer nil
246 pop3-fma-commandline-arguments)
247 (let ((string (buffer-string)))
248 (if (> (length string) 0)
251 (concat (substring string 0
252 (- (length string) 1))
256 (pop3-movemail crashbox))))
257 (message "Checking new mail at %s ... " inbox)
258 (call-process (concat exec-directory pop3-fma-movemail-program)
264 (message "Checking new mail at %s ... done." inbox)))
267 (defun pop3-fma-read-passwd (mailhost)
268 (setq passwd (nth 2 (assoc mailhost pop3-fma-password)))
271 (defun pop3-fma-input-password (mailhost maildrop)
272 (pop3-fma-read-noecho
273 (format "POP Password for %s at %s: " maildrop mailhost) t))
275 (setq pop3-read-passwd 'pop3-fma-read-passwd
276 nnmail-read-passwd 'pop3-fma-read-passwd)
278 ;; Set multiple pop3 server's password
279 (defun pop3-fma-store-password (passwd)
281 (list (pop3-fma-read-noecho
282 (format "POP Password for %s at %s: " pop3-maildrop pop3-mailhost) t)))
283 (if (not (assoc pop3-mailhost pop3-fma-password))
284 (setq pop3-fma-password
285 (append pop3-fma-password
291 (setcar (cdr (cdr (assoc pop3-mailhost pop3-fma-password)))
293 (message "POP password registered.")
297 (defun pop3-fma-set-pop3-password()
299 (if pop3-fma-save-password-information
304 (substring (car x) (match-end (string-match "^po:" (car x)))
305 (- (match-end (string-match "^.*@" (car x))) 1)))
307 (substring (car x) (match-end (string-match "^.*@" (car x))))))
308 (call-interactively 'pop3-fma-store-password)))
309 pop3-fma-spool-file-alist)))
310 (setq nnmail-movemail-program 'pop3-fma-movemail)
311 ;; (setq nnmail-spool-file pop3-fma-spool-file-alist))
312 (setq nnmail-spool-file (append
313 pop3-fma-local-spool-file-alist
317 pop3-fma-spool-file-alist))))
319 (defmacro pop3-fma-read-char-exclusive ()
320 (cond ((featurep 'xemacs)
321 '(let ((table (quote ((backspace . ?\C-h) (delete . ?\C-?)
326 (key-press-event-p (setq event (next-command-event)))
327 (setq key (or (event-to-character event)
328 (cdr (assq (event-key event) table)))))))
330 ((fboundp 'read-char-exclusive)
331 '(read-char-exclusive))
335 (defun pop3-fma-read-noecho (prompt &optional stars)
336 "Read a single line of text from user without echoing, and return it.
341 (cursor-in-echo-area t)
342 (log-message-max-size 0)
343 message-log-max done msg truncate)
345 (if (or (not stars) (string-equal "" ans))
347 (setq msg (concat prompt (make-string (length ans) ?*)))
349 (1+ (- (length msg) (window-width (minibuffer-window)))))
351 (setq msg (concat "$" (substring msg (1+ truncate))))))
353 (setq c (pop3-fma-read-char-exclusive))
357 ((memq c '(?\r ?\n ?\e))
361 ((and (/= ?\b c) (/= ?\177 c))
362 (setq ans (concat ans (char-to-string c))))
364 (setq ans (substring ans 0 -1)))))
374 (defun pop3-fma-message-add-header ()
376 (pop3-fma-add-custom-header "X-Ya-Pop3:" pop3-fma-version)))
379 ;; Add your custom header.
380 (defun pop3-fma-add-custom-header (header string)
382 (progn (goto-char (point-min))
384 (concat "^" (regexp-quote mail-header-separator) "\n"))
386 (goto-char (point-min))
387 (or (re-search-forward (concat "^" header) delimline t)
389 (goto-char delimline)
392 (setq hdr (concat header " "))
393 (setq str (concat hdr string))
394 (setq hdr (concat str "\n"))
395 (insert-string hdr)))))
398 (defun pop3-fma-get-movemail-type (inbox)
399 (if (eq (nth 1 (assoc inbox pop3-fma-spool-file-alist)) 'apop)
401 pop3-fma-movemail-type))
405 ;; pop3-fma.el ends here.