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