← Back to branch summary

~ubuntu-branches/ubuntu/gutsy/amsn/gutsy

« back to all changes in this revision

Viewing changes to plugins/BWidget-1.7.0/labelframe.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Theodore Karkoulis
  • Date: 2006-01-04 15:26:02 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20060104152602-ipe1yg00rl3nlklv
Tags: 0.95-1
http://bugs.debian.org/345052
http://bugs.debian.org/278575
New Upstream Release (closes: #345052, #278575).

Show diffs side-by-side

added added

removed removed

Lines of Context:
plugins/BWidget-1.7.0/labelframe.tcl
1
 
# ------------------------------------------------------------------------------
2
 
#  labelframe.tcl
3
 
#  This file is part of Unifix BWidget Toolkit
4
 
#  $Id: labelframe.tcl,v 1.1 2004/03/04 00:47:28 airadier Exp $
5
 
# ------------------------------------------------------------------------------
6
 
#  Index of commands:
7
 
#     - LabelFrame::create
8
 
#     - LabelFrame::getframe
9
 
#     - LabelFrame::configure
10
 
#     - LabelFrame::cget
11
 
#     - LabelFrame::align
12
 
# ------------------------------------------------------------------------------
13
 
 
14
 
namespace 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
 
# ----------------------------------------------------------------------------
46
 
proc 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
 
# ----------------------------------------------------------------------------
78
 
proc LabelFrame::getframe { path } {
79
 
    return $path.f
80
 
}
81
 
 
82
 
 
83
 
# ----------------------------------------------------------------------------
84
 
#  Command LabelFrame::configure
85
 
# ----------------------------------------------------------------------------
86
 
proc LabelFrame::configure { path args } {
87
 
    return [Widget::configure $path $args]
88
 
}
89
 
 
90
 
 
91
 
# ----------------------------------------------------------------------------
92
 
#  Command LabelFrame::cget
93
 
# ----------------------------------------------------------------------------
94
 
proc 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
 
# ----------------------------------------------------------------------------
104
 
proc 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
 
 
158
 
proc LabelFrame::_destroy { path } {
159
 
    Widget::destroy $path
160
 
}