462
+ − 1 ;;; gtk-password-dialog.el --- Reading passwords in a dialog
+ − 2
+ − 3 ;; Copyright (C) 2000 Free Software Foundation, Inc.
+ − 4
+ − 5 ;; Maintainer: William M. Perry <wmperry@gnu.org>
+ − 6 ;; Keywords: extensions, internal
+ − 7
+ − 8 ;; This file is part of XEmacs.
+ − 9
+ − 10 ;; XEmacs is free software; you can redistribute it and/or modify it
+ − 11 ;; under the terms of the GNU General Public License as published by
+ − 12 ;; the Free Software Foundation; either version 2, or (at your option)
+ − 13 ;; any later version.
+ − 14
+ − 15 ;; XEmacs is distributed in the hope that it will be useful, but
+ − 16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
+ − 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ − 18 ;; General Public License for more details.
+ − 19
+ − 20 ;; You should have received a copy of the GNU General Public License
+ − 21 ;; along with XEmacs; see the file COPYING. If not, write to the
+ − 22 ;; Free Software Foundation, 59 Temple Place - Suite 330,
+ − 23 ;; Boston, MA 02111-1307, USA.
+ − 24
+ − 25 ;;; Synched up with: Not in FSF.
+ − 26
502
+ − 27 (globally-declare-fboundp
+ − 28 '(gtk-dialog-new
+ − 29 gtk-dialog-vbox gtk-dialog-action-area
+ − 30 gtk-window-set-title gtk-button-new-with-label
+ − 31 gtk-container-add gtk-signal-connect gtk-entry-get-text
+ − 32 gtk-widget-destroy gtk-container-set-border-width gtk-label-new
+ − 33 gtk-misc-set-alignment gtk-entry-new gtk-widget-set-sensitive
+ − 34 gtk-entry-set-text gtk-entry-select-region))
+ − 35
462
+ − 36 (defun gtk-password-dialog-ok-button (dlg)
+ − 37 (get dlg 'x-ok-button))
+ − 38
+ − 39 (defun gtk-password-dialog-cancel-button (dlg)
+ − 40 (get dlg 'x-cancel-button))
+ − 41
+ − 42 (defun gtk-password-dialog-entry-widget (dlg)
+ − 43 (get dlg 'x-initial-entry))
+ − 44
+ − 45 (defun gtk-password-dialog-confirmation-widget (dlg)
+ − 46 (get dlg 'x-verify-entry))
+ − 47
+ − 48 (defun gtk-password-dialog-new (&rest keywords)
+ − 49 ;; Format is (:keyword value ...)
+ − 50 ;; Allowed keywords are:
+ − 51 ;;
+ − 52 ;; :callback function
+ − 53 ;; :default string
+ − 54 ;; :title string
+ − 55 :; :prompt string
+ − 56 ;; :default string
+ − 57 ;; :verify boolean
+ − 58 ;; :verify-prompt string
+ − 59 (let* ((callback (plist-get keywords :callback 'ignore))
+ − 60 (dialog (gtk-dialog-new))
+ − 61 (vbox (gtk-dialog-vbox dialog))
+ − 62 (button-area (gtk-dialog-action-area dialog))
+ − 63 (default (plist-get keywords :default))
+ − 64 (widget nil))
+ − 65 (gtk-window-set-title dialog (plist-get keywords :title "Enter password..."))
+ − 66
+ − 67 ;; Make us modal...
+ − 68 (put dialog 'type 'dialog)
+ − 69
+ − 70 ;; Put the buttons in the bottom
+ − 71 (setq widget (gtk-button-new-with-label "OK"))
+ − 72 (gtk-container-add button-area widget)
+ − 73 (gtk-signal-connect widget 'clicked
+ − 74 (lambda (button data)
+ − 75 (funcall (car data)
+ − 76 (gtk-entry-get-text
+ − 77 (get (cdr data) 'x-initial-entry))))
+ − 78 (cons callback dialog))
+ − 79 (put dialog 'x-ok-button widget)
+ − 80
+ − 81 (setq widget (gtk-button-new-with-label "Cancel"))
+ − 82 (gtk-container-add button-area widget)
+ − 83 (gtk-signal-connect widget 'clicked
+ − 84 (lambda (button dialog)
+ − 85 (gtk-widget-destroy dialog))
+ − 86 dialog)
+ − 87 (put dialog 'x-cancel-button widget)
+ − 88
+ − 89 ;; Now the entry area...
+ − 90 (gtk-container-set-border-width vbox 5)
+ − 91 (setq widget (gtk-label-new (plist-get keywords :prompt "Password:")))
+ − 92 (gtk-misc-set-alignment widget 0.0 0.5)
+ − 93 (gtk-container-add vbox widget)
+ − 94
+ − 95 (setq widget (gtk-entry-new))
+ − 96 (put widget 'visibility nil)
+ − 97 (gtk-container-add vbox widget)
+ − 98 (put dialog 'x-initial-entry widget)
+ − 99
+ − 100 (if (plist-get keywords :verify)
+ − 101 (let ((changed-cb (lambda (editable dialog)
+ − 102 (gtk-widget-set-sensitive
+ − 103 (get dialog 'x-ok-button)
+ − 104 (equal (gtk-entry-get-text
+ − 105 (get dialog 'x-initial-entry))
+ − 106 (gtk-entry-get-text
+ − 107 (get dialog 'x-verify-entry)))))))
+ − 108 (gtk-container-set-border-width vbox 5)
+ − 109 (setq widget (gtk-label-new (plist-get keywords :verify-prompt "Verify:")))
+ − 110 (gtk-misc-set-alignment widget 0.0 0.5)
+ − 111 (gtk-container-add vbox widget)
+ − 112
+ − 113 (setq widget (gtk-entry-new))
+ − 114 (put widget 'visibility nil)
+ − 115 (gtk-container-add vbox widget)
+ − 116 (put dialog 'x-verify-entry widget)
+ − 117
+ − 118 (gtk-signal-connect (get dialog 'x-initial-entry)
+ − 119 'changed changed-cb dialog)
+ − 120 (gtk-signal-connect (get dialog 'x-verify-entry)
+ − 121 'changed changed-cb dialog)
+ − 122 (gtk-widget-set-sensitive (get dialog 'x-ok-button) nil)))
+ − 123
+ − 124 (if default
+ − 125 (progn
+ − 126 (gtk-entry-set-text (get dialog 'x-initial-entry) default)
+ − 127 (gtk-entry-select-region (get dialog 'x-initial-entry)
+ − 128 0 (length default))))
+ − 129 dialog))
+ − 130
+ − 131 (provide 'gtk-password-dialog)