1# ------------------------------------------------------------------------------
2#  labelentry.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: labelentry.tcl,v 1.61 2009/09/06 21:17:15 oberdorfer 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    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 BWidget::wrap frame $path] \
43              $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    return [Widget::create LabelEntry $path]
59}
60
61
62# ------------------------------------------------------------------------------
63#  Command LabelEntry::configure
64# ------------------------------------------------------------------------------
65proc LabelEntry::configure { path args } {
66    return [Widget::configure $path $args]
67}
68
69
70# ------------------------------------------------------------------------------
71#  Command LabelEntry::cget
72# ------------------------------------------------------------------------------
73proc LabelEntry::cget { path option } {
74    return [Widget::cget $path $option]
75}
76
77
78# ------------------------------------------------------------------------------
79#  Command LabelEntry::bind
80# ------------------------------------------------------------------------------
81proc LabelEntry::bind { path args } {
82    return [eval [list ::bind $path.e] $args]
83}
84
85
86#------------------------------------------------------------------------------
87#  Command LabelEntry::_path_command
88#------------------------------------------------------------------------------
89proc LabelEntry::_path_command { path cmd larg } {
90    if { [string equal $cmd "configure"] ||
91         [string equal $cmd "cget"] ||
92         [string equal $cmd "bind"] } {
93        return [eval [list LabelEntry::$cmd $path] $larg]
94    } else {
95        return [eval [list $path.e:cmd $cmd] $larg]
96    }
97}
98
99
100proc LabelEntry::_destroy { path } {
101    Widget::destroy $path
102}
103