source: trunk/BWidget-1.2.1/labelentry.tcl @ 931

Last change on this file since 931 was 931, checked in by toby, 11 years ago

include rest of files

File size: 3.5 KB
Line 
1# ------------------------------------------------------------------------------
2#  labelentry.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: labelentry.tcl,v 1.5 1999/05/20 15:45:36 eric Exp $
5# ------------------------------------------------------------------------------
6#  Index of commands:
7#     - LabelEntry::create
8#     - LabelEntry::configure
9#     - LabelEntry::cget
10#     - LabelEntry::bind
11# ------------------------------------------------------------------------------
12
13namespace 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# ------------------------------------------------------------------------------
42proc 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    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    rename $path ::$path:cmd
59    proc ::$path { cmd args } "return \[LabelEntry::_path_command $path \$cmd \$args\]"
60
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 ::bind $path.e $args]
86}
87
88
89#------------------------------------------------------------------------------
90#  Command LabelEntry::_path_command
91#------------------------------------------------------------------------------
92proc LabelEntry::_path_command { path cmd larg } {
93    if { ![string compare $cmd "configure"] ||
94         ![string compare $cmd "cget"] ||
95         ![string compare $cmd "bind"] } {
96        return [eval LabelEntry::$cmd $path $larg]
97    } else {
98        return [eval $path.e:cmd $cmd $larg]
99    }
100}
Note: See TracBrowser for help on using the repository browser.