1# ------------------------------------------------------------------------------ 2# labelentry.tcl 3# This file is part of Unifix BWidget Toolkit 4# $Id: labelentry.tcl,v 1.6.2.1 2011/02/14 16:56:09 oehhar Exp $ 5# ------------------------------------------------------------------------------ 6# Index of commands: 7# - LabelEntry::create 8# - LabelEntry::configure 9# - LabelEntry::cget 10# - LabelEntry::bind 11# ------------------------------------------------------------------------------ 12 13namespace eval LabelEntry { 14 Widget::define LabelEntry labelentry Entry LabelFrame 15 16 Widget::bwinclude LabelEntry LabelFrame .labf \ 17 remove {-relief -borderwidth -focus} \ 18 rename {-text -label} \ 19 prefix {label -justify -width -anchor -height -font -textvariable} 20 21 Widget::bwinclude LabelEntry Entry .e \ 22 remove {-fg -bg} \ 23 rename {-foreground -entryfg -background -entrybg} 24 25 Widget::addmap LabelEntry "" :cmd {-background {}} 26 27 ::bind BwLabelEntry <FocusIn> [list focus %W.labf] 28 ::bind BwLabelEntry <Destroy> [list LabelEntry::_destroy %W] 29} 30 31 32# ------------------------------------------------------------------------------ 33# Command LabelEntry::create 34# ------------------------------------------------------------------------------ 35proc LabelEntry::create { path args } { 36 array set maps [list LabelEntry {} :cmd {} .labf {} .e {}] 37 array set maps [Widget::parseArgs LabelEntry $args] 38 39 if {[Widget::theme]} { 40 eval [list ttk::frame $path] $maps(:cmd) -class LabelEntry \ 41 -takefocus 0 42 } else { 43 eval [list frame $path] $maps(:cmd) -class LabelEntry \ 44 -relief flat -bd 0 -highlightthickness 0 -takefocus 0 45 } 46 Widget::initFromODB LabelEntry $path $maps(LabelEntry) 47 48 set labf [eval [list LabelFrame::create $path.labf] $maps(.labf) \ 49 [list -relief flat -borderwidth 0 -focus $path.e]] 50 set subf [LabelFrame::getframe $labf] 51 set entry [eval [list Entry::create $path.e] $maps(.e)] 52 53 pack $entry -in $subf -fill both -expand yes 54 pack $labf -fill both -expand yes 55 56 bindtags $path [list $path BwLabelEntry [winfo toplevel $path] all] 57 58 Widget::create LabelEntry $path 59 proc ::$path { cmd args } \ 60 "return \[LabelEntry::_path_command [list $path] \$cmd \$args\]" 61 return $path 62} 63 64 65# ------------------------------------------------------------------------------ 66# Command LabelEntry::configure 67# ------------------------------------------------------------------------------ 68proc LabelEntry::configure { path args } { 69 return [Widget::configure $path $args] 70} 71 72 73# ------------------------------------------------------------------------------ 74# Command LabelEntry::cget 75# ------------------------------------------------------------------------------ 76proc LabelEntry::cget { path option } { 77 return [Widget::cget $path $option] 78} 79 80 81# ------------------------------------------------------------------------------ 82# Command LabelEntry::bind 83# ------------------------------------------------------------------------------ 84proc LabelEntry::bind { path args } { 85 return [eval [list ::bind $path.e] $args] 86} 87 88 89#------------------------------------------------------------------------------ 90# Command LabelEntry::_path_command 91#------------------------------------------------------------------------------ 92proc LabelEntry::_path_command { path cmd larg } { 93 if { [string equal $cmd "configure"] || 94 [string equal $cmd "cget"] || 95 [string equal $cmd "bind"] } { 96 return [eval [list LabelEntry::$cmd $path] $larg] 97 } else { 98 return [eval [list $path.e:cmd $cmd] $larg] 99 } 100} 101 102 103proc LabelEntry::_destroy { path } { 104 Widget::destroy $path 105} 106