1# ----------------------------------------------------------------------------- 2# passwddlg.tcl 3# This file is part of Unifix BWidget Toolkit 4# by Stephane Lavirotte (Stephane.Lavirotte@sophia.inria.fr) 5# $Id: passwddlg.tcl,v 1.12 2009/06/11 15:42:51 oehhar Exp $ 6# ----------------------------------------------------------------------------- 7# Index of commands: 8# - PasswdDlg::create 9# - PasswdDlg::configure 10# - PasswdDlg::cget 11# - PasswdDlg::_verifonlogin 12# - PasswdDlg::_verifonpasswd 13# - PasswdDlg::_max 14#------------------------------------------------------------------------------ 15 16namespace eval PasswdDlg { 17 Widget::define PasswdDlg passwddlg Dialog LabelEntry 18 19 Widget::bwinclude PasswdDlg Dialog :cmd \ 20 remove {-image -bitmap -side -default -cancel -separator} \ 21 initialize {-modal local -anchor e} 22 23 Widget::bwinclude PasswdDlg LabelEntry .frame.lablog \ 24 remove [list -command -justify -name -show -side \ 25 -state -takefocus -width -xscrollcommand -padx -pady \ 26 -dragenabled -dragendcmd -dragevent -draginitcmd \ 27 -dragtype -dropenabled -dropcmd -dropovercmd -droptypes \ 28 ] \ 29 prefix [list login -editable -helptext -helpvar -label \ 30 -text -textvariable -underline \ 31 ] \ 32 initialize [list -relief sunken -borderwidth 2 \ 33 -labelanchor w -width 15 -loginlabel "Login" \ 34 ] 35 36 Widget::bwinclude PasswdDlg LabelEntry .frame.labpass \ 37 remove [list -command -width -show -side -takefocus \ 38 -xscrollcommand -dragenabled -dragendcmd -dragevent \ 39 -draginitcmd -dragtype -dropenabled -dropcmd \ 40 -dropovercmd -droptypes -justify -padx -pady -name \ 41 ] \ 42 prefix [list passwd -editable -helptext -helpvar -label \ 43 -state -text -textvariable -underline \ 44 ] \ 45 initialize [list -relief sunken -borderwidth 2 \ 46 -labelanchor w -width 15 -passwdlabel "Password" \ 47 ] 48 49 Widget::declare PasswdDlg { 50 {-type Enum ok 0 {ok okcancel}} 51 {-labelwidth TkResource -1 0 {label -width}} 52 {-command String "" 0} 53 } 54} 55 56 57# ----------------------------------------------------------------------------- 58# Command PasswdDlg::create 59# ----------------------------------------------------------------------------- 60proc PasswdDlg::create { path args } { 61 62 array set maps [list PasswdDlg {} :cmd {} .frame.lablog {} \ 63 .frame.labpass {}] 64 array set maps [Widget::parseArgs PasswdDlg $args] 65 66 Widget::initFromODB PasswdDlg "$path#PasswdDlg" $maps(PasswdDlg) 67 68 # Extract the PasswdDlg megawidget options (those that don't map to a 69 # subwidget) 70 set type [Widget::cget "$path#PasswdDlg" -type] 71 set cmd [Widget::cget "$path#PasswdDlg" -command] 72 73 set defb -1 74 set canb -1 75 switch -- $type { 76 ok { set lbut {ok}; set defb 0 } 77 okcancel { set lbut {ok cancel} ; set defb 0; set canb 1 } 78 } 79 80 eval [list Dialog::create $path] $maps(:cmd) \ 81 [list -class PasswdDlg -image [Bitmap::get passwd] \ 82 -side bottom -default $defb -cancel $canb] 83 foreach but $lbut { 84 if { $but == "ok" && $cmd != "" } { 85 Dialog::add $path -text $but -name $but -command $cmd 86 } else { 87 Dialog::add $path -text $but -name $but 88 } 89 } 90 91 set frame [Dialog::getframe $path] 92 bind $path <Return> "" 93 bind $frame <Destroy> [list Widget::destroy $path\#PasswdDlg] 94 95 set lablog [eval [list LabelEntry::create $frame.lablog] \ 96 $maps(.frame.lablog) \ 97 [list -name login -dragenabled 0 -dropenabled 0 \ 98 -command [list PasswdDlg::_verifonpasswd \ 99 $path $frame.labpass]]] 100 101 set labpass [eval [list LabelEntry::create $frame.labpass] \ 102 $maps(.frame.labpass) \ 103 [list -name password -show "*" \ 104 -dragenabled 0 -dropenabled 0 \ 105 -command [list PasswdDlg::_verifonlogin \ 106 $path $frame.lablog]]] 107 108 # compute label width 109 if {[$lablog cget -labelwidth] == 0} { 110 set loglabel [$lablog cget -label] 111 set passlabel [$labpass cget -label] 112 set labwidth [_max [string length $loglabel] [string length $passlabel]] 113 incr labwidth 1 114 $lablog configure -labelwidth $labwidth 115 $labpass configure -labelwidth $labwidth 116 } 117 118 Widget::create PasswdDlg $path 0 119 120 pack $frame.lablog $frame.labpass -fill x -expand 1 121 122 # added by bach@mwgdna.com 123 # give focus to loginlabel unless the state is disabled 124 if {[$lablog cget -editable]} { 125 focus $frame.lablog.e 126 } else { 127 focus $frame.labpass.e 128 } 129 set res [Dialog::draw $path] 130 131 if { $res == 0 } { 132 set res [list [$lablog.e cget -text] [$labpass.e cget -text]] 133 } else { 134 set res [list] 135 } 136 Widget::destroy "$path#PasswdDlg" 137 destroy $path 138 139 return $res 140} 141 142# ----------------------------------------------------------------------------- 143# Command PasswdDlg::configure 144# ----------------------------------------------------------------------------- 145 146proc PasswdDlg::configure { path args } { 147 set res [Widget::configure "$path#PasswdDlg" $args] 148} 149 150# ----------------------------------------------------------------------------- 151# Command PasswdDlg::cget 152# ----------------------------------------------------------------------------- 153 154proc PasswdDlg::cget { path option } { 155 return [Widget::cget "$path#PasswdDlg" $option] 156} 157 158 159# ----------------------------------------------------------------------------- 160# Command PasswdDlg::_verifonlogin 161# ----------------------------------------------------------------------------- 162proc PasswdDlg::_verifonlogin { path labpass } { 163 Dialog::enddialog $path 0 164} 165 166# ----------------------------------------------------------------------------- 167# Command PasswdDlg::_verifonpasswd 168# ----------------------------------------------------------------------------- 169proc PasswdDlg::_verifonpasswd { path labpass } { 170 if {[string equal [$labpass cget -state] "disabled"]} { 171 Dialog::enddialog $path 0 172 } else { 173 focus $labpass 174 } 175} 176 177# ----------------------------------------------------------------------------- 178# Command PasswdDlg::_max 179# ----------------------------------------------------------------------------- 180proc PasswdDlg::_max { val1 val2 } { 181 return [expr {($val1 > $val2) ? ($val1) : ($val2)}] 182} 183