cgit.sxemacs.org Git - packages/blob - xemacs-packages/ecrypto/paranoid.el

   1 ;;;  paranoid.el -- even more paranoid password prompter
   2
   3 ;; Copyright (C) 1998 Ray Jones
   4
   5 ;; Author: Ray Jones, rjones@pobox.com
   6 ;; Keywords: password, comint
   7 ;; Created: 1998-05-20
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13 ;;
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18 ;;
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program; if not, you can either send email to this
  21 ;; program's maintainer or write to: The Free Software Foundation,
  22 ;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; taken from comint.el, so it doesn't have to be loaded in its
  27 ;; entirety, and made a little more paranoid.
  28
  29 ;; (defun comint-read-noecho (prompt &optional stars) ...)
  30 (defun prompt-paranoidly (prompt)
  31
  32   "Read a single line of text from user without echoing, and return
  33 it.  Prompt with argument PROMPT, a string.  Input ends with RET, LFD,
  34 or ESC.  DEL or C-h rubs out.  C-u kills line.  C-g aborts (if
  35 `inhibit-quit' is set because e.g. this function was called from a
  36 process filter and C-g is pressed, this function returns nil rather
  37 than a string).
  38
  39 Note that the keystrokes comprising the text can still be recovered
  40 \(temporarily) with \\[view-lossage].  Some people find this worrysome.
  41 Once the caller uses the password, it can erase the password
  42 by doing \(fillarray STRING 0)."
  43   (let ((ans "")
  44         (newans nil)
  45         (c 0)
  46         (echo-keystrokes 0)
  47         (cursor-in-echo-area t)
  48         (message-log-max nil)
  49         (done nil))
  50     (while (not done)
  51       (message "%s" prompt)
  52       ;; Use this instead of `read-char' to avoid "Non-character input-event".
  53       (setq c (read-char-exclusive))
  54       (cond ((= c ?\C-g)
  55              ;; This function may get called from a process filter, where
  56              ;; inhibit-quit is set.  In later versions of emacs read-char
  57              ;; may clear quit-flag itself and return C-g.  That would make
  58              ;; it impossible to quit this loop in a simple way, so
  59              ;; re-enable it here (for backward-compatibility the check for
  60              ;; quit-flag below would still be necessary, so this seems
  61              ;; like the simplest way to do things).
  62              (fillarray ans 0)
  63              (setq quit-flag t
  64                    done t))
  65             ((or (= c ?\r) (= c ?\n) (= c ?\e))
  66              (setq done t))
  67             ((= c ?\C-u)
  68              (fillarray ans 0)
  69              (setq ans ""))
  70             ((and (/= c ?\b) (/= c ?\177))
  71              (setq newans (concat ans (char-to-string c)))
  72              (fillarray ans 0)
  73              (setq ans newans))
  74             ((> (length ans) 0)
  75              (setq newans (substring ans 0 -1))
  76              (fillarray ans 0)
  77              (setq ans newans))))
  78     (if quit-flag
  79         ;; Emulate a true quit, except that we have to return a value.
  80         (prog1
  81             (setq quit-flag nil)
  82           (message "Quit")
  83           (beep t))
  84       (message "")
  85       ans)))
  86
  87 (provide 'paranoid)