1 ;; read-passwd.el.el --- Read password function for Pterodactyl Gnus.
2 ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. , Tatsuya Ichikawa
3 ;; Author: Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
5 ;; Keywords: mail , gnus , pop3 , password
8 ;; Katsumi Yamaoka <yamaoka@jpl.org>
10 ;; This file is part of Semi-gnus.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
28 (require 'mail-source)
30 (defun read-pw-read-passwd (prompt)
31 (read-pw-read-noecho prompt t))
33 (defmacro read-pw-read-char-exclusive ()
34 (cond ((featurep 'xemacs)
35 '(let ((table (quote ((backspace . ?\C-h) (delete . ?\C-?)
40 (key-press-event-p (setq event (next-command-event)))
41 (setq key (or (event-to-character event)
42 (cdr (assq (event-key event) table)))))))
44 ((fboundp 'read-char-exclusive)
45 '(read-char-exclusive))
49 (defun read-pw-read-noecho (prompt &optional stars)
50 "Read a single line of text from user without echoing, and return it.
55 (cursor-in-echo-area t)
56 (log-message-max-size 0)
57 message-log-max done msg truncate)
59 (if (or (not stars) (string-equal "" ans))
61 (setq msg (concat prompt (make-string (length ans) ?*)))
63 (1+ (- (length msg) (window-width (minibuffer-window)))))
65 (setq msg (concat "$" (substring msg (1+ truncate))))))
67 (setq c (read-pw-read-char-exclusive))
71 ((memq c '(?\r ?\n ?\e))
75 ((and (/= ?\b c) (/= ?\177 c))
76 (setq ans (concat ans (char-to-string c))))
78 (setq ans (substring ans 0 -1)))))
88 (defun read-pw-set-mail-source-passwd-cache ()
89 (if (not mail-source-password-cache)
92 (mail-source-bind (pop x)
93 (let ((from (format "%s:%s:%s" server user port))
95 (format "%s:%s@%s" (car x) user server)))
96 (setq pw (read-pw-return-passwd-string user server))
97 (unless (assoc user mail-source-password-cache)
98 (set-alist 'mail-source-password-cache
99 (format "%s:%s:%s" server user port)
101 (cdr (assoc from mail-source-password-cache)))))
102 nnmail-spool-file))))
106 (defun read-pw-return-passwd-string (user server)
107 (setq passwd (read-pw-read-passwd
108 (message "POP Password for %s at %s : " user server)))
111 (provide 'read-passwd)