1# ------------------------------------------------------------------------------
2#  labelframe.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: labelframe.tcl 606 2004-04-05 07:06:06Z mcourtoi $
5# ------------------------------------------------------------------------------
6#  Index of commands:
7#     - LabelFrame::create
8#     - LabelFrame::getframe
9#     - LabelFrame::configure
10#     - LabelFrame::cget
11#     - LabelFrame::align
12# ------------------------------------------------------------------------------
13
14namespace eval LabelFrame {
15    Widget::define LabelFrame labelframe Label
16
17    Widget::bwinclude LabelFrame Label .l \
18        remove     {
19            -highlightthickness -highlightcolor -highlightbackground
20            -takefocus -relief -borderwidth
21            -cursor
22            -dragenabled -draginitcmd -dragendcmd -dragevent -dragtype
23            -dropenabled -droptypes -dropovercmd  -dropcmd} \
24        initialize {-anchor w}
25
26    Widget::declare LabelFrame {
27        {-relief      TkResource flat 0 frame}
28        {-borderwidth TkResource 0    0 frame}
29        {-side        Enum       left 1 {left right top bottom}}
30        {-bd          Synonym    -borderwidth}
31    }
32
33    Widget::addmap LabelFrame "" :cmd {-background {}}
34    Widget::addmap LabelFrame "" .f   {-background {} -relief {} -borderwidth {}}
35
36    Widget::syncoptions LabelFrame Label .l {-text {} -underline {}}
37
38    bind BwLabelFrame <FocusIn> [list Label::setfocus %W.l]
39    bind BwLabelFrame <Destroy> [list LabelFrame::_destroy %W]
40}
41
42
43# ----------------------------------------------------------------------------
44#  Command LabelFrame::create
45# ----------------------------------------------------------------------------
46proc LabelFrame::create { path args } {
47    Widget::init LabelFrame $path $args
48
49    set path  [eval [list frame $path] [Widget::subcget $path :cmd] \
50	    -relief flat -bd 0 -takefocus 0 -highlightthickness 0 \
51	    -class LabelFrame]
52
53    set label [eval [list Label::create $path.l] [Widget::subcget $path .l] \
54                   -takefocus 0 -highlightthickness 0 -relief flat \
55		   -borderwidth 0 -dropenabled 0 -dragenabled 0]
56    set frame [eval [list frame $path.f] [Widget::subcget $path .f] \
57                   -highlightthickness 0 -takefocus 0]
58
59    switch  [Widget::getoption $path -side] {
60        left   {set packopt "-side left"}
61        right  {set packopt "-side right"}
62        top    {set packopt "-side top -fill x"}
63        bottom {set packopt "-side bottom -fill x"}
64    }
65
66    eval [list pack $label] $packopt
67    pack $frame -fill both -expand yes
68
69    bindtags $path [list $path BwLabelFrame [winfo toplevel $path] all]
70
71    return [Widget::create LabelFrame $path]
72}
73
74
75# ----------------------------------------------------------------------------
76#  Command LabelFrame::getframe
77# ----------------------------------------------------------------------------
78proc LabelFrame::getframe { path } {
79    return $path.f
80}
81
82
83# ----------------------------------------------------------------------------
84#  Command LabelFrame::configure
85# ----------------------------------------------------------------------------
86proc LabelFrame::configure { path args } {
87    return [Widget::configure $path $args]
88}
89
90
91# ----------------------------------------------------------------------------
92#  Command LabelFrame::cget
93# ----------------------------------------------------------------------------
94proc LabelFrame::cget { path option } {
95    return [Widget::cget $path $option]
96}
97
98
99# ----------------------------------------------------------------------------
100#  Command LabelFrame::align
101#  This command align label of all widget given by args of class LabelFrame
102#  (or "derived") by setting their width to the max one +1
103# ----------------------------------------------------------------------------
104proc LabelFrame::align { args } {
105    set maxlen 0
106    set wlist  {}
107    foreach wl $args {
108        foreach w $wl {
109            if { ![info exists Widget::_class($w)] } {
110                continue
111            }
112            set class $Widget::_class($w)
113            if { [string equal $class "LabelFrame"] } {
114                set textopt  -text
115                set widthopt -width
116            } else {
117                upvar 0 Widget::${class}::map classmap
118                set textopt  ""
119                set widthopt ""
120                set notdone  2
121                foreach {option lmap} [array get classmap] {
122                    foreach {subpath subclass realopt} $lmap {
123                        if { [string equal $subclass "LabelFrame"] } {
124                            if { [string equal $realopt "-text"] } {
125                                set textopt $option
126                                incr notdone -1
127                                break
128                            }
129                            if { [string equal $realopt "-width"] } {
130                                set widthopt $option
131                                incr notdone -1
132                                break
133                            }
134                        }
135                    }
136                    if { !$notdone } {
137                        break
138                    }
139                }
140                if { $notdone } {
141                    continue
142                }
143            }
144            set len [string length [$w cget $textopt]]
145            if { $len > $maxlen } {
146                set maxlen $len
147            }
148            lappend wlist $w $widthopt
149        }
150    }
151    incr maxlen
152    foreach {w widthopt} $wlist {
153        $w configure $widthopt $maxlen
154    }
155}
156
157
158proc LabelFrame::_destroy { path } {
159    Widget::destroy $path
160}
161