1# ------------------------------------------------------------------------------
2#  labelframe.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: labelframe.tcl,v 1.61 2009/09/06 21:19:09 oberdorfer Exp $
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    if { ![BWidget::using ttk] } {
34        Widget::addmap LabelFrame "" :cmd {-background {}}
35        Widget::addmap LabelFrame "" .f   {-background {} -relief {} -borderwidth {}}
36    } else {
37        Widget::addmap LabelFrame "" .f   {-relief {} -borderwidth {}}
38    }
39
40    Widget::syncoptions LabelFrame Label .l {-text {} -underline {}}
41
42    bind BwLabelFrame <FocusIn> [list Label::setfocus %W.l]
43    bind BwLabelFrame <Destroy> [list LabelFrame::_destroy %W]
44}
45
46
47# ----------------------------------------------------------------------------
48#  Command LabelFrame::create
49# ----------------------------------------------------------------------------
50proc LabelFrame::create { path args } {
51    Widget::init LabelFrame $path $args
52
53    set path  [eval [list BWidget::wrap frame $path] \
54                         [Widget::subcget $path :cmd] \
55                         -relief flat -bd 0 -takefocus 0 -highlightthickness 0 \
56	                 -class LabelFrame]
57
58    set label [eval [list Label::create $path.l] \
59                         [Widget::subcget $path .l] \
60                         -takefocus 0 -highlightthickness 0 -relief flat \
61		         -borderwidth 0 -dropenabled 0 -dragenabled 0]
62
63    set frame [eval [list BWidget::wrap frame $path.f] \
64                         [Widget::subcget $path .f] \
65                         -highlightthickness 0 -takefocus 0]
66
67    switch  [Widget::getoption $path -side] {
68        left   {set packopt "-side left"}
69        right  {set packopt "-side right"}
70        top    {set packopt "-side top -fill x"}
71        bottom {set packopt "-side bottom -fill x"}
72    }
73
74    eval [list pack $label] $packopt
75    pack $frame -fill both -expand yes
76
77    bindtags $path [list $path BwLabelFrame [winfo toplevel $path] all]
78
79    return [Widget::create LabelFrame $path]
80}
81
82
83# ----------------------------------------------------------------------------
84#  Command LabelFrame::getframe
85# ----------------------------------------------------------------------------
86proc LabelFrame::getframe { path } {
87    return $path.f
88}
89
90
91# ----------------------------------------------------------------------------
92#  Command LabelFrame::configure
93# ----------------------------------------------------------------------------
94proc LabelFrame::configure { path args } {
95    return [Widget::configure $path $args]
96}
97
98
99# ----------------------------------------------------------------------------
100#  Command LabelFrame::cget
101# ----------------------------------------------------------------------------
102proc LabelFrame::cget { path option } {
103    return [Widget::cget $path $option]
104}
105
106
107# ----------------------------------------------------------------------------
108#  Command LabelFrame::align
109#  This command align label of all widget given by args of class LabelFrame
110#  (or "derived") by setting their width to the max one +1
111# ----------------------------------------------------------------------------
112proc LabelFrame::align { args } {
113    set maxlen 0
114    set wlist  {}
115    foreach wl $args {
116        foreach w $wl {
117            if { ![info exists Widget::_class($w)] } {
118                continue
119            }
120            set class $Widget::_class($w)
121            if { [string equal $class "LabelFrame"] } {
122                set textopt  -text
123                set widthopt -width
124            } else {
125                upvar 0 Widget::${class}::map classmap
126                set textopt  ""
127                set widthopt ""
128                set notdone  2
129                foreach {option lmap} [array get classmap] {
130                    foreach {subpath subclass realopt} $lmap {
131                        if { [string equal $subclass "LabelFrame"] } {
132                            if { [string equal $realopt "-text"] } {
133                                set textopt $option
134                                incr notdone -1
135                                break
136                            }
137                            if { [string equal $realopt "-width"] } {
138                                set widthopt $option
139                                incr notdone -1
140                                break
141                            }
142                        }
143                    }
144                    if { !$notdone } {
145                        break
146                    }
147                }
148                if { $notdone } {
149                    continue
150                }
151            }
152            set len [string length [$w cget $textopt]]
153            if { $len > $maxlen } {
154                set maxlen $len
155            }
156            lappend wlist $w $widthopt
157        }
158    }
159    incr maxlen
160    foreach {w widthopt} $wlist {
161        $w configure $widthopt $maxlen
162    }
163}
164
165
166proc LabelFrame::_destroy { path } {
167    Widget::destroy $path
168}
169