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
|
# ------------------------------------------------------------------------------
# labelentry.tcl
# This file is part of Unifix BWidget Toolkit
# $Id: labelentry.tcl,v 1.5 1999/05/20 15:45:36 eric Exp $
# ------------------------------------------------------------------------------
# Index of commands:
# - LabelEntry::create
# - LabelEntry::configure
# - LabelEntry::cget
# - LabelEntry::bind
# ------------------------------------------------------------------------------
namespace eval LabelEntry {
Entry::use
LabelFrame::use
Widget::bwinclude LabelEntry LabelFrame .labf \
remove {-relief -borderwidth -focus} \
rename {-text -label} \
prefix {label -justify -width -anchor -height -font} \
Widget::bwinclude LabelEntry Entry .e \
remove {-fg -bg} \
rename {-foreground -entryfg -background -entrybg}
Widget::addmap LabelEntry "" :cmd {-background {}}
Widget::syncoptions LabelEntry Entry .e {-text {}}
Widget::syncoptions LabelEntry LabelFrame .labf {-label -text -underline {}}
::bind BwLabelEntry <FocusIn> {focus %W.labf}
::bind BwLabelEntry <Destroy> {Widget::destroy %W; rename %W {}}
proc ::LabelEntry { path args } { return [eval LabelEntry::create $path $args] }
proc use { } {}
}
# ------------------------------------------------------------------------------
# Command LabelEntry::create
# ------------------------------------------------------------------------------
proc LabelEntry::create { path args } {
Widget::init LabelEntry $path $args
eval frame $path [Widget::subcget $path :cmd] \
-relief flat -bd 0 -highlightthickness 0 -takefocus 0
set labf [eval LabelFrame::create $path.labf [Widget::subcget $path .labf] \
-relief flat -borderwidth 0 -focus $path.e]
set subf [LabelFrame::getframe $labf]
set entry [eval Entry::create $path.e [Widget::subcget $path .e]]
pack $entry -in $subf -fill both -expand yes
pack $labf -fill both -expand yes
bindtags $path [list $path BwLabelEntry [winfo toplevel $path] all]
rename $path ::$path:cmd
proc ::$path { cmd args } "return \[LabelEntry::_path_command $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 ::bind $path.e $args]
}
#------------------------------------------------------------------------------
# Command LabelEntry::_path_command
#------------------------------------------------------------------------------
proc LabelEntry::_path_command { path cmd larg } {
if { ![string compare $cmd "configure"] ||
![string compare $cmd "cget"] ||
![string compare $cmd "bind"] } {
return [eval LabelEntry::$cmd $path $larg]
} else {
return [eval $path.e:cmd $cmd $larg]
}
}
|
