home *** CD-ROM | disk | FTP | other *** search
/ PCNET 2006 September - Disc 1 / PCNET_CD_2006_09.iso / linux / puppy-barebones-2.01r2.iso / pup_201.sfs / usr / lib / bwidget / passwddlg.tcl < prev    next >
Encoding:
Text File  |  2003-08-12  |  6.1 KB  |  177 lines
  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.5 2001/06/11 23:58:40 hobbs 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.  
  16. namespace eval PasswdDlg {
  17.     Dialog::use
  18.     LabelEntry::use
  19.  
  20.     Widget::bwinclude PasswdDlg Dialog :cmd \
  21.         remove     {-image -bitmap -side -default -cancel -separator} \
  22.         initialize {-modal local -anchor c}
  23.     
  24.     Widget::bwinclude PasswdDlg LabelEntry .frame.lablog \
  25.         remove [list -command -editable -justify -name -show -side    \
  26.         -state -takefocus -width -xscrollcommand -padx -pady    \
  27.         -dragenabled -dragendcmd -dragevent -draginitcmd    \
  28.         -dragtype -dropenabled -dropcmd -dropovercmd -droptypes    \
  29.         ] \
  30.         prefix [list login -helptext -helpvar -label -text         \
  31.         -textvariable -underline                \
  32.         ] \
  33.         initialize [list -relief sunken -borderwidth 2        \
  34.         -labelanchor w -width 15 -loginlabel "Login"        \
  35.         ]
  36.     
  37.     Widget::bwinclude PasswdDlg LabelEntry .frame.labpass        \
  38.         remove [list -command -width -show -side -takefocus        \
  39.         -xscrollcommand -dragenabled -dragendcmd -dragevent    \
  40.         -draginitcmd -dragtype -dropenabled -dropcmd        \
  41.         -dropovercmd -droptypes -justify -padx -pady -name    \
  42.         ] \
  43.         prefix [list passwd -editable -helptext -helpvar -label    \
  44.         -state -text -textvariable -underline            \
  45.         ] \
  46.         initialize [list -relief sunken -borderwidth 2        \
  47.         -labelanchor w -width 15 -passwdlabel "Password"    \
  48.         ]
  49.     
  50.     Widget::declare PasswdDlg {
  51.         {-type        Enum       ok           0 {ok okcancel}}
  52.         {-labelwidth  TkResource -1           0 {label -width}}
  53.         {-command     String     ""           0}
  54.     }
  55.  
  56.     proc ::PasswdDlg { path args } { return [eval PasswdDlg::create $path $args] }
  57.     proc use {} {}
  58. }
  59.  
  60.  
  61. # -----------------------------------------------------------------------------
  62. #  Command PasswdDlg::create
  63. # -----------------------------------------------------------------------------
  64. proc PasswdDlg::create { path args } {
  65.  
  66.     array set maps [list PasswdDlg {} :cmd {} .frame.lablog {} \
  67.         .frame.labpass {}]
  68.     array set maps [Widget::parseArgs PasswdDlg $args]
  69.  
  70.     Widget::initFromODB PasswdDlg "$path#PasswdDlg" $maps(PasswdDlg)
  71.  
  72.     # Extract the PasswdDlg megawidget options (those that don't map to a
  73.     # subwidget)
  74.     set type      [Widget::cget "$path#PasswdDlg" -type]
  75.     set cmd       [Widget::cget "$path#PasswdDlg" -command]
  76.  
  77.     set defb -1
  78.     set canb -1
  79.     switch -- $type {
  80.         ok        { set lbut {ok}; set defb 0 }
  81.         okcancel  { set lbut {ok cancel} ; set defb 0; set canb 1 }
  82.     }
  83.  
  84.     eval Dialog::create $path $maps(:cmd) -class PasswdDlg \
  85.         -image [Bitmap::get passwd] -side bottom -default $defb -cancel $canb
  86.     foreach but $lbut {
  87.         if { $but == "ok" && $cmd != "" } {
  88.             Dialog::add $path -text $but -name $but -command $cmd
  89.         } else {
  90.             Dialog::add $path -text $but -name $but
  91.         }
  92.     }
  93.  
  94.     set frame [Dialog::getframe $path]
  95. #    bind $path  <Return>  ""
  96.     bind $frame <Destroy> "Widget::destroy $path#PasswdDlg"
  97.  
  98.     set lablog [eval LabelEntry::create $frame.lablog $maps(.frame.lablog) \
  99.         -name login -dragenabled 0 -dropenabled 0 \
  100.         -command \"PasswdDlg::_verifonpasswd $path $frame.labpass\"]
  101.  
  102.     set labpass [eval LabelEntry::create $frame.labpass $maps(.frame.labpass) \
  103.         -name password -show "*" -dragenabled 0 -dropenabled 0 \
  104.         -command \"PasswdDlg::_verifonlogin $path $frame.lablog\"]
  105.  
  106.     # compute label width -- TODO: this should probably not override the
  107.     # cmdline arg
  108.     set loglabel  [$lablog cget -label]
  109.     set passlabel [$labpass cget -label]
  110.     set labwidth  [_max [string length $loglabel] [string length $passlabel]]
  111.     incr labwidth 1
  112.     $lablog  configure -labelwidth $labwidth
  113.     $labpass configure -labelwidth $labwidth
  114.  
  115.     proc ::$path { cmd args } "return \[eval PasswdDlg::\$cmd $path \$args\]"
  116.  
  117.     pack  $frame.lablog $frame.labpass -fill x -expand 1
  118.     focus $frame.lablog.e
  119.     set res [Dialog::draw $path]
  120.  
  121.     if { $res == 0 } {
  122.         set res [list [$lablog.e cget -text] [$labpass.e cget -text]]
  123.     } else {
  124.         set res [list]
  125.     }
  126.     Widget::destroy "$path#PasswdDlg"
  127.     destroy $path
  128.  
  129.     return $res
  130. }
  131.  
  132. # -----------------------------------------------------------------------------
  133. #  Command PasswdDlg::configure
  134. # -----------------------------------------------------------------------------
  135.  
  136. proc PasswdDlg::configure { path args } {
  137.     set res [Widget::configure "$path#PasswdDlg" $args]
  138. }
  139.  
  140. # -----------------------------------------------------------------------------
  141. #  Command PasswdDlg::cget
  142. # -----------------------------------------------------------------------------
  143.  
  144. proc PasswdDlg::cget { path option } {
  145.     return [Widget::cget "$path#PasswdDlg" $option]
  146. }
  147.  
  148.  
  149. # -----------------------------------------------------------------------------
  150. #  Command PasswdDlg::_verifonlogin
  151. # -----------------------------------------------------------------------------
  152. proc PasswdDlg::_verifonlogin { path labpass } {
  153.     if { [$labpass.e cget -text] == "" } {
  154.         focus $labpass
  155.     } else {
  156.         Dialog::setfocus $path default
  157.     }
  158. }
  159.  
  160. # -----------------------------------------------------------------------------
  161. #  Command PasswdDlg::_verifonpasswd
  162. # -----------------------------------------------------------------------------
  163. proc PasswdDlg::_verifonpasswd { path lablog } {
  164.     if { [$lablog.e cget -text] == "" } {
  165.         focus $lablog
  166.     } else {
  167.         Dialog::setfocus $path default
  168.     }
  169. }
  170.  
  171. # -----------------------------------------------------------------------------
  172. #  Command PasswdDlg::_max
  173. # -----------------------------------------------------------------------------
  174. proc PasswdDlg::_max { val1 val2 } { 
  175.     return [expr {($val1 > $val2) ? ($val1) : ($val2)}] 
  176. }
  177.