home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / BWidget-1.2 / labelentry.tcl < prev    next >
Text File  |  2000-11-02  |  4KB  |  103 lines
  1. # ------------------------------------------------------------------------------
  2. #  labelentry.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. #  $Id: labelentry.tcl,v 1.1.1.1 1996/02/22 06:05:56 daniel Exp $
  5. # ------------------------------------------------------------------------------
  6. #  Index of commands:
  7. #     - LabelEntry::create
  8. #     - LabelEntry::configure
  9. #     - LabelEntry::cget
  10. #     - LabelEntry::bind
  11. # ------------------------------------------------------------------------------
  12.  
  13. namespace eval LabelEntry {
  14.     Entry::use
  15.     LabelFrame::use
  16.  
  17.     Widget::bwinclude LabelEntry LabelFrame .labf \
  18.         remove {-relief -borderwidth -focus} \
  19.         rename {-text -label} \
  20.         prefix {label -justify -width -anchor -height -font} \
  21.  
  22.     Widget::bwinclude LabelEntry Entry .e \
  23.         remove {-fg -bg} \
  24.         rename {-foreground -entryfg -background -entrybg}
  25.  
  26.     Widget::addmap LabelEntry "" :cmd {-background {}}
  27.  
  28.     Widget::syncoptions LabelEntry Entry .e {-text {}}
  29.     Widget::syncoptions LabelEntry LabelFrame .labf {-label -text -underline {}}
  30.  
  31.     ::bind BwLabelEntry <FocusIn> {focus %W.labf}
  32.     ::bind BwLabelEntry <Destroy> {Widget::destroy %W; rename %W {}}
  33.  
  34.     proc ::LabelEntry { path args } { return [eval LabelEntry::create $path $args] }
  35.     proc use { } {}
  36. }
  37.  
  38.  
  39. # ------------------------------------------------------------------------------
  40. #  Command LabelEntry::create
  41. # ------------------------------------------------------------------------------
  42. proc LabelEntry::create { path args } {
  43.     Widget::init LabelEntry $path $args
  44.  
  45.     eval frame $path [Widget::subcget $path :cmd] \
  46.         -relief flat -bd 0 -highlightthickness 0 -takefocus 0
  47.     
  48.     set labf  [eval LabelFrame::create $path.labf [Widget::subcget $path .labf] \
  49.                    -relief flat -borderwidth 0 -focus $path.e]
  50.     set subf  [LabelFrame::getframe $labf]
  51.     set entry [eval Entry::create $path.e [Widget::subcget $path .e]]
  52.     
  53.     # Changed by Dani((()))
  54.     
  55.     pack $entry -in $subf -fill x -expand yes
  56.     pack $labf  -fill both -expand yes
  57.  
  58.     bindtags $path [list $path BwLabelEntry [winfo toplevel $path] all]
  59.  
  60.     rename $path ::$path:cmd
  61.     proc ::$path { cmd args } "return \[LabelEntry::_path_command $path \$cmd \$args\]"
  62.  
  63.     return $path
  64. }
  65.  
  66.  
  67. # ------------------------------------------------------------------------------
  68. #  Command LabelEntry::configure
  69. # ------------------------------------------------------------------------------
  70. proc LabelEntry::configure { path args } {
  71.     return [Widget::configure $path $args]
  72. }
  73.  
  74.  
  75. # ------------------------------------------------------------------------------
  76. #  Command LabelEntry::cget
  77. # ------------------------------------------------------------------------------
  78. proc LabelEntry::cget { path option } {
  79.     return [Widget::cget $path $option]
  80. }
  81.  
  82.  
  83. # ------------------------------------------------------------------------------
  84. #  Command LabelEntry::bind
  85. # ------------------------------------------------------------------------------
  86. proc LabelEntry::bind { path args } {
  87.     return [eval ::bind $path.e $args]
  88. }
  89.  
  90.  
  91. #------------------------------------------------------------------------------
  92. #  Command LabelEntry::_path_command
  93. #------------------------------------------------------------------------------
  94. proc LabelEntry::_path_command { path cmd larg } {
  95.     if { ![string compare $cmd "configure"] ||
  96.          ![string compare $cmd "cget"] ||
  97.          ![string compare $cmd "bind"] } {
  98.         return [eval LabelEntry::$cmd $path $larg]
  99.     } else {
  100.         return [eval $path.e:cmd $cmd $larg]
  101.     }
  102. }
  103.