1 ;;; gtk-password-dialog.el --- Reading passwords in a dialog
3 ;; Copyright (C) 2000 Free Software Foundation, Inc.
5 ;; Maintainer: William M. Perry <wmperry@gnu.org>
6 ;; Keywords: extensions, internal
8 ;; This file is part of SXEmacs.
10 ;; SXEmacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; SXEmacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
23 ;;; Synched up with: Not in FSF.
25 (globally-declare-fboundp
27 gtk-dialog-vbox gtk-dialog-action-area
28 gtk-window-set-title gtk-button-new-with-label
29 gtk-container-add gtk-signal-connect gtk-entry-get-text
30 gtk-widget-destroy gtk-container-set-border-width gtk-label-new
31 gtk-misc-set-alignment gtk-entry-new gtk-widget-set-sensitive
32 gtk-entry-set-text gtk-entry-select-region))
34 (defun gtk-password-dialog-ok-button (dlg)
35 (get dlg 'x-ok-button))
37 (defun gtk-password-dialog-cancel-button (dlg)
38 (get dlg 'x-cancel-button))
40 (defun gtk-password-dialog-entry-widget (dlg)
41 (get dlg 'x-initial-entry))
43 (defun gtk-password-dialog-confirmation-widget (dlg)
44 (get dlg 'x-verify-entry))
46 (defun gtk-password-dialog-new (&rest keywords)
47 ;; Format is (:keyword value ...)
48 ;; Allowed keywords are:
56 ;; :verify-prompt string
57 (let* ((callback (plist-get keywords :callback 'ignore))
58 (dialog (gtk-dialog-new))
59 (vbox (gtk-dialog-vbox dialog))
60 (button-area (gtk-dialog-action-area dialog))
61 (default (plist-get keywords :default))
63 (gtk-window-set-title dialog (plist-get keywords :title "Enter password..."))
66 (put dialog 'type 'dialog)
68 ;; Put the buttons in the bottom
69 (setq widget (gtk-button-new-with-label "OK"))
70 (gtk-container-add button-area widget)
71 (gtk-signal-connect widget 'clicked
75 (get (cdr data) 'x-initial-entry))))
76 (cons callback dialog))
77 (put dialog 'x-ok-button widget)
79 (setq widget (gtk-button-new-with-label "Cancel"))
80 (gtk-container-add button-area widget)
81 (gtk-signal-connect widget 'clicked
82 (lambda (button dialog)
83 (gtk-widget-destroy dialog))
85 (put dialog 'x-cancel-button widget)
87 ;; Now the entry area...
88 (gtk-container-set-border-width vbox 5)
89 (setq widget (gtk-label-new (plist-get keywords :prompt "Password:")))
90 (gtk-misc-set-alignment widget 0.0 0.5)
91 (gtk-container-add vbox widget)
93 (setq widget (gtk-entry-new))
94 (put widget 'visibility nil)
95 (gtk-container-add vbox widget)
96 (put dialog 'x-initial-entry widget)
98 (if (plist-get keywords :verify)
99 (let ((changed-cb (lambda (editable dialog)
100 (gtk-widget-set-sensitive
101 (get dialog 'x-ok-button)
102 (equal (gtk-entry-get-text
103 (get dialog 'x-initial-entry))
105 (get dialog 'x-verify-entry)))))))
106 (gtk-container-set-border-width vbox 5)
107 (setq widget (gtk-label-new (plist-get keywords :verify-prompt "Verify:")))
108 (gtk-misc-set-alignment widget 0.0 0.5)
109 (gtk-container-add vbox widget)
111 (setq widget (gtk-entry-new))
112 (put widget 'visibility nil)
113 (gtk-container-add vbox widget)
114 (put dialog 'x-verify-entry widget)
116 (gtk-signal-connect (get dialog 'x-initial-entry)
117 'changed changed-cb dialog)
118 (gtk-signal-connect (get dialog 'x-verify-entry)
119 'changed changed-cb dialog)
120 (gtk-widget-set-sensitive (get dialog 'x-ok-button) nil)))
124 (gtk-entry-set-text (get dialog 'x-initial-entry) default)
125 (gtk-entry-select-region (get dialog 'x-initial-entry)
126 0 (length default))))
129 (provide 'gtk-password-dialog)