Mercurial > hg > xemacs-beta

comparison lisp/gtk-password-dialog.el @ 462:0784d089fdc9 r21-2-46

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-46
author cvs
date Mon, 13 Aug 2007 11:44:37 +0200
parents
children 7039e6323819
comparison
equal deleted inserted replaced
461:120ed4009e51 462:0784d089fdc9
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
27 (defun gtk-password-dialog-ok-button (dlg)
28 (get dlg 'x-ok-button))
29
30 (defun gtk-password-dialog-cancel-button (dlg)
31 (get dlg 'x-cancel-button))
32
33 (defun gtk-password-dialog-entry-widget (dlg)
34 (get dlg 'x-initial-entry))
35
36 (defun gtk-password-dialog-confirmation-widget (dlg)
37 (get dlg 'x-verify-entry))
38
39 (defun gtk-password-dialog-new (&rest keywords)
40 ;; Format is (:keyword value ...)
41 ;; Allowed keywords are:
42 ;;
43 ;; :callback function
44 ;; :default string
45 ;; :title string
46 :; :prompt string
47 ;; :default string
48 ;; :verify boolean
49 ;; :verify-prompt string
50 (let* ((callback (plist-get keywords :callback 'ignore))
51 (dialog (gtk-dialog-new))
52 (vbox (gtk-dialog-vbox dialog))
53 (button-area (gtk-dialog-action-area dialog))
54 (default (plist-get keywords :default))
55 (widget nil))
56 (gtk-window-set-title dialog (plist-get keywords :title "Enter password..."))
57
58 ;; Make us modal...
59 (put dialog 'type 'dialog)
60
61 ;; Put the buttons in the bottom
62 (setq widget (gtk-button-new-with-label "OK"))
63 (gtk-container-add button-area widget)
64 (gtk-signal-connect widget 'clicked
65 (lambda (button data)
66 (funcall (car data)
67 (gtk-entry-get-text
68 (get (cdr data) 'x-initial-entry))))
69 (cons callback dialog))
70 (put dialog 'x-ok-button widget)
71
72 (setq widget (gtk-button-new-with-label "Cancel"))
73 (gtk-container-add button-area widget)
74 (gtk-signal-connect widget 'clicked
75 (lambda (button dialog)
76 (gtk-widget-destroy dialog))
77 dialog)
78 (put dialog 'x-cancel-button widget)
79
80 ;; Now the entry area...
81 (gtk-container-set-border-width vbox 5)
82 (setq widget (gtk-label-new (plist-get keywords :prompt "Password:")))
83 (gtk-misc-set-alignment widget 0.0 0.5)
84 (gtk-container-add vbox widget)
85
86 (setq widget (gtk-entry-new))
87 (put widget 'visibility nil)
88 (gtk-container-add vbox widget)
89 (put dialog 'x-initial-entry widget)
90
91 (if (plist-get keywords :verify)
92 (let ((changed-cb (lambda (editable dialog)
93 (gtk-widget-set-sensitive
94 (get dialog 'x-ok-button)
95 (equal (gtk-entry-get-text
96 (get dialog 'x-initial-entry))
97 (gtk-entry-get-text
98 (get dialog 'x-verify-entry)))))))
99 (gtk-container-set-border-width vbox 5)
100 (setq widget (gtk-label-new (plist-get keywords :verify-prompt "Verify:")))
101 (gtk-misc-set-alignment widget 0.0 0.5)
102 (gtk-container-add vbox widget)
103
104 (setq widget (gtk-entry-new))
105 (put widget 'visibility nil)
106 (gtk-container-add vbox widget)
107 (put dialog 'x-verify-entry widget)
108
109 (gtk-signal-connect (get dialog 'x-initial-entry)
110 'changed changed-cb dialog)
111 (gtk-signal-connect (get dialog 'x-verify-entry)
112 'changed changed-cb dialog)
113 (gtk-widget-set-sensitive (get dialog 'x-ok-button) nil)))
114
115 (if default
116 (progn
117 (gtk-entry-set-text (get dialog 'x-initial-entry) default)
118 (gtk-entry-select-region (get dialog 'x-initial-entry)
119 0 (length default))))
120 dialog))
121
122 (provide 'gtk-password-dialog)