1# ------------------------------------------------------------------------------ 2# labelentry.tcl 3# This file is part of Unifix BWidget Toolkit 4# $Id: labelentry.tcl 606 2004-04-05 07:06:06Z mcourtoi $ 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 Widget::syncoptions LabelEntry Entry .e {-text {}} 28 Widget::syncoptions LabelEntry LabelFrame .labf {-label -text -underline {}} 29 30 ::bind BwLabelEntry <FocusIn> [list focus %W.labf] 31 ::bind BwLabelEntry <Destroy> [list LabelEntry::_destroy %W] 32} 33 34 35# ------------------------------------------------------------------------------ 36# Command LabelEntry::create 37# ------------------------------------------------------------------------------ 38proc LabelEntry::create { path args } { 39 array set maps [list LabelEntry {} :cmd {} .labf {} .e {}] 40 array set maps [Widget::parseArgs LabelEntry $args] 41 42 eval [list frame $path] $maps(:cmd) -class LabelEntry \ 43 -relief flat -bd 0 -highlightthickness 0 -takefocus 0 44 Widget::initFromODB LabelEntry $path $maps(LabelEntry) 45 46 set labf [eval [list LabelFrame::create $path.labf] $maps(.labf) \ 47 [list -relief flat -borderwidth 0 -focus $path.e]] 48 set subf [LabelFrame::getframe $labf] 49 set entry [eval [list Entry::create $path.e] $maps(.e)] 50 51 pack $entry -in $subf -fill both -expand yes 52 pack $labf -fill both -expand yes 53 54 bindtags $path [list $path BwLabelEntry [winfo toplevel $path] all] 55 56 return [Widget::create LabelEntry $path] 57} 58 59 60# ------------------------------------------------------------------------------ 61# Command LabelEntry::configure 62# ------------------------------------------------------------------------------ 63proc LabelEntry::configure { path args } { 64 return [Widget::configure $path $args] 65} 66 67 68# ------------------------------------------------------------------------------ 69# Command LabelEntry::cget 70# ------------------------------------------------------------------------------ 71proc LabelEntry::cget { path option } { 72 return [Widget::cget $path $option] 73} 74 75 76# ------------------------------------------------------------------------------ 77# Command LabelEntry::bind 78# ------------------------------------------------------------------------------ 79proc LabelEntry::bind { path args } { 80 return [eval [list ::bind $path.e] $args] 81} 82 83 84#------------------------------------------------------------------------------ 85# Command LabelEntry::_path_command 86#------------------------------------------------------------------------------ 87proc LabelEntry::_path_command { path cmd larg } { 88 if { [string equal $cmd "configure"] || 89 [string equal $cmd "cget"] || 90 [string equal $cmd "bind"] } { 91 return [eval [list LabelEntry::$cmd $path] $larg] 92 } else { 93 return [eval [list $path.e:cmd $cmd] $larg] 94 } 95} 96 97 98proc LabelEntry::_destroy { path } { 99 Widget::destroy $path 100} 101