home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / BWidget-1.2 / passwddlg.tcl < prev    next >
Encoding:
Text File  |  2000-11-02  |  6.8 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.1.1.1 1996/02/22 06:05:56 daniel 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 "" \
  21.         remove     {-image -bitmap -side -default -cancel -separator} \
  22.         initialize {-modal local -anchor c}
  23.  
  24.     Widget::bwinclude PasswdDlg LabelEntry .frame.lablog \
  25.         remove {
  26.             -command -editable -justify -name -show -side -state -takefocus
  27.             -width -xscrollcommand -padx -pady
  28.             -dragenabled -dragendcmd -dragevent -draginitcmd -dragtype
  29.             -dropenabled -dropcmd -dropovercmd -droptypes
  30.         } \
  31.         prefix     {login -helptext -helpvar -label -text -textvariable -underline} \
  32.         initialize {-relief sunken -borderwidth 2 -labelanchor w -width 15 -loginlabel "Login"}
  33.  
  34.     Widget::bwinclude PasswdDlg LabelEntry .frame.labpass \
  35.         remove {
  36.             -command -width -show -side -takefocus -xscrollcommand
  37.             -dragenabled -dragendcmd -dragevent -draginitcmd -dragtype
  38.             -dropenabled -dropcmd -dropovercmd -droptypes -justify -padx -pady -name
  39.         } \
  40.         prefix {passwd -editable -helptext -helpvar -label -state -text -textvariable -underline} \
  41.         initialize {-relief sunken -borderwidth 2 -labelanchor w -width 15 -passwdlabel "Password"}
  42.  
  43.     Widget::declare PasswdDlg {
  44.         {-type        Enum       ok           0 {ok okcancel}}
  45.         {-labelwidth  TkResource -1           0 {label -width}}
  46.         {-command     String     ""           0}
  47.     }
  48.  
  49.     Widget::syncoptions PasswdDlg LabelEntry .frame.lablog  {
  50.         -logintext -text -loginlabel -label -loginunderline -underline
  51.     }
  52.     Widget::syncoptions PasswdDlg LabelEntry .frame.labpass {
  53.         -passwdtext -text -passwdlabel -label -passwdunderline -underline
  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.     Widget::init PasswdDlg "$path#PasswdDlg" $args
  67.     set type      [Widget::getoption "$path#PasswdDlg" -type]
  68.     set loglabel  [Widget::getoption "$path#PasswdDlg" -loginlabel]
  69.     set passlabel [Widget::getoption "$path#PasswdDlg" -passwdlabel]
  70.     set labwidth  [Widget::getoption "$path#PasswdDlg" -labelwidth]
  71.     set cmd       [Widget::getoption "$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 Dialog::create $path [Widget::subcget "$path#PasswdDlg" ""] \
  81.         -image [Bitmap::get passwd] -side bottom -default $defb -cancel $canb
  82.     foreach but $lbut {
  83.         if { $but == "ok" && $cmd != "" } {
  84.             Dialog::add $path -text $but -name $but -command $cmd
  85.         } else {
  86.             Dialog::add $path -text $but -name $but
  87.         }
  88.     }
  89.     set frame [Dialog::getframe $path]
  90.     bind $path  <Return>  ""
  91.     bind $frame <Destroy> "Widget::destroy $path#PasswdDlg"
  92.  
  93.     set lablog [eval LabelEntry::create $frame.lablog \
  94.                     [Widget::subcget "$path#PasswdDlg" .frame.lablog] \
  95.                     -label \"$loglabel\" -name login \
  96.                     -dragenabled 0 -dropenabled 0 \
  97.                     -command \"PasswdDlg::_verifonpasswd $path $frame.labpass\"]
  98.  
  99.     set labpass [eval LabelEntry::create $frame.labpass \
  100.                      [Widget::subcget "$path#PasswdDlg" .frame.labpass] \
  101.                      -label \"$passlabel\" -name password -show "*" \
  102.                      -dragenabled 0 -dropenabled 0 \
  103.                      -command \"PasswdDlg::_verifonlogin $path $frame.lablog\"]
  104.  
  105.     if { $labwidth == -1 } {
  106.         # les options -label sont mises a jour selon -name
  107.         set loglabel  [$lablog cget -label]
  108.         set passlabel [$labpass cget -label]
  109.         set labwidth  [PasswdDlg::_max [string length $loglabel] [string length $passlabel]]
  110.         incr labwidth 1
  111.         $lablog  configure -labelwidth $labwidth
  112.         $labpass configure -labelwidth $labwidth
  113.     }
  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.