URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tix/] [library/] [LabWidg.tcl] - Blame information for rev 1782

Go to most recent revision | Details | Compare with Previous | View Log


# LabWidg.tcl --
#
#       TixLabelWidget: Virtual base class. Do not instantiate
#
#       This widget class is the base class for all widgets that has a
#       label. Most Tix compound widgets will have a label so that
#       the app programmer doesn't need to add labels themselvel.
#
#
# Copyright (c) 1996, Expert Interface Technologies
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
 
# LabelSide : top, left, right, bottom, none, acrosstop
#
# public widgets:
#       frame, label
#
 
tixWidgetClass tixLabelWidget {
    -superclass tixPrimitive
    -classname  TixLabelWidget
    -flag {
        -label -labelside -padx -pady
    }
    -static {-labelside}
    -configspec {
        {-label label Label ""}
        {-labelside labelSide LabelSide left}
        {-padx padX Pad 0}
        {-pady padY Pad 0}
    }
}
 
proc tixLabelWidget:ConstructWidget {w} {
    upvar #0 $w data
 
    tixChainMethod $w ConstructWidget
 
    if {$data(-labelside) != "acrosstop"} {
        set data(w:frame) [frame $w.frame]
    } else {
        set data(pw:border) [frame $w.border]
        set data(pw:pad)    [frame $w.border.pad]
        set data(w:frame)   [frame $w.border.frame]
    }
 
    if {$data(-labelside) != "none"} {
        set data(w:label) [label $w.label -text $data(-label)]
    }
    tixLabelWidget:Pack $w
 
    tixCallMethod $w ConstructFramedWidget $data(w:frame)
}
 
proc tixLabelWidget:ConstructFramedWidget {w frame} {
    # Do nothing
}
 
proc tixLabelWidget:Pack {w} {
    upvar #0 $w data
 
    if [catch {tixLabelWidget:Pack-$data(-labelside) $w}] {
        error "unknown -labelside option \"$data(-labelside)\""
    }
}
 
proc tixLabelWidget:Pack-acrosstop {w} {
    upvar #0 $w data
 
    set labHalfHeight [expr [winfo reqheight $data(w:label)] / 2]
    set padHeight [expr $labHalfHeight - [$data(pw:border) cget -bd]]
    if {$padHeight < 0} {
        set padHeight 0
    }
 
    tixForm $data(w:label) -top 0 -left 4\
        -padx [expr $data(-padx) +4] -pady $data(-pady)
    tixForm $data(pw:border) -top $labHalfHeight -bottom -1 \
        -left 0 -right -1 -padx $data(-padx) -pady $data(-pady)
    tixForm $data(pw:pad) -left 0 -right -1 \
        -top 0 -bottom $padHeight
    tixForm $data(w:frame) -top $data(pw:pad) -bottom -1 \
        -left 0 -right -1
}
 
proc tixLabelWidget:Pack-top {w} {
    upvar #0 $w data
 
    pack $data(w:label) -side top \
        -padx $data(-padx) -pady $data(-pady) \
        -fill x
    pack $data(w:frame) -side top \
        -padx $data(-padx) -pady $data(-pady) \
        -expand yes -fill both
}
 
proc tixLabelWidget:Pack-bottom {w} {
    upvar #0 $w data
 
    pack $data(w:label) -side bottom \
        -padx $data(-padx) -pady $data(-pady) \
        -fill x
    pack $data(w:frame) -side bottom \
        -padx $data(-padx) -pady $data(-pady) \
        -expand yes -fill both
}
 
proc tixLabelWidget:Pack-left {w} {
    upvar #0 $w data
 
    pack $data(w:label) -side left \
        -padx $data(-padx) -pady $data(-pady) \
        -fill y
    pack $data(w:frame) -side left \
        -padx $data(-padx) -pady $data(-pady) \
        -expand yes -fill both
}
 
proc tixLabelWidget:Pack-right {w} {
    upvar #0 $w data
 
    pack $data(w:label) -side right \
        -padx $data(-padx) -pady $data(-pady) \
        -fill x
    pack $data(w:frame) -side right \
        -padx $data(-padx) -pady $data(-pady) \
        -expand yes -fill both
}
 
proc tixLabelWidget:Pack-none {w} {
    upvar #0 $w data
 
    pack $data(w:frame)\
        -padx $data(-padx) -pady $data(-pady) \
        -expand yes -fill both
}
 
#----------------------------------------------------------------------
#                           CONFIG OPTIONS
#----------------------------------------------------------------------
proc tixLabelWidget:config-label {w value} {
    upvar #0 $w data
 
    $data(w:label) config -text $value
 
    if {$data(-labelside) == "acrosstop"} {
        tixLabelWidget:Pack-acrosstop $w
    }
}

Line No.	Rev	Author	Line
1	578	markom	`# LabWidg.tcl --`
2			`#`
3			`# TixLabelWidget: Virtual base class. Do not instantiate`
4			`#`
5			`# This widget class is the base class for all widgets that has a`
6			`# label. Most Tix compound widgets will have a label so that`
7			`# the app programmer doesn't need to add labels themselvel.`
8			`#`
9			`#`
10			`# Copyright (c) 1996, Expert Interface Technologies`
11			`#`
12			`# See the file "license.terms" for information on usage and redistribution`
13			`# of this file, and for a DISCLAIMER OF ALL WARRANTIES.`
14			`#`
15
16			`# LabelSide : top, left, right, bottom, none, acrosstop`
17			`#`
18			`# public widgets:`
19			`# frame, label`
20			`#`
21
22			`tixWidgetClass tixLabelWidget {`
23			`-superclass tixPrimitive`
24			`-classname TixLabelWidget`
25			`-flag {`
26			`-label -labelside -padx -pady`
27			`}`
28			`-static {-labelside}`
29			`-configspec {`
30			`{-label label Label ""}`
31			`{-labelside labelSide LabelSide left}`
32			`{-padx padX Pad 0}`
33			`{-pady padY Pad 0}`
34			`}`
35			`}`
36
37			`proc tixLabelWidget:ConstructWidget {w} {`
38			`upvar #0 $w data`
39
40			`tixChainMethod $w ConstructWidget`
41
42			`if {$data(-labelside) != "acrosstop"} {`
43			`set data(w:frame) [frame $w.frame]`
44			`} else {`
45			`set data(pw:border) [frame $w.border]`
46			`set data(pw:pad) [frame $w.border.pad]`
47			`set data(w:frame) [frame $w.border.frame]`
48			`}`
49
50			`if {$data(-labelside) != "none"} {`
51			`set data(w:label) [label $w.label -text $data(-label)]`
52			`}`
53			`tixLabelWidget:Pack $w`
54
55			`tixCallMethod $w ConstructFramedWidget $data(w:frame)`
56			`}`
57
58			`proc tixLabelWidget:ConstructFramedWidget {w frame} {`
59			`# Do nothing`
60			`}`
61
62			`proc tixLabelWidget:Pack {w} {`
63			`upvar #0 $w data`
64
65			`if [catch {tixLabelWidget:Pack-$data(-labelside) $w}] {`
66			`error "unknown -labelside option \"$data(-labelside)\""`
67			`}`
68			`}`
69
70			`proc tixLabelWidget:Pack-acrosstop {w} {`
71			`upvar #0 $w data`
72
73			`set labHalfHeight [expr [winfo reqheight $data(w:label)] / 2]`
74			`set padHeight [expr $labHalfHeight - [$data(pw:border) cget -bd]]`
75			`if {$padHeight < 0} {`
76			`set padHeight 0`
77			`}`
78
79			`tixForm $data(w:label) -top 0 -left 4\`
80			`-padx [expr $data(-padx) +4] -pady $data(-pady)`
81			`tixForm $data(pw:border) -top $labHalfHeight -bottom -1 \`
82			`-left 0 -right -1 -padx $data(-padx) -pady $data(-pady)`
83			`tixForm $data(pw:pad) -left 0 -right -1 \`
84			`-top 0 -bottom $padHeight`
85			`tixForm $data(w:frame) -top $data(pw:pad) -bottom -1 \`
86			`-left 0 -right -1`
87			`}`
88
89			`proc tixLabelWidget:Pack-top {w} {`
90			`upvar #0 $w data`
91
92			`pack $data(w:label) -side top \`
93			`-padx $data(-padx) -pady $data(-pady) \`
94			`-fill x`
95			`pack $data(w:frame) -side top \`
96			`-padx $data(-padx) -pady $data(-pady) \`
97			`-expand yes -fill both`
98			`}`
99
100			`proc tixLabelWidget:Pack-bottom {w} {`
101			`upvar #0 $w data`
102
103			`pack $data(w:label) -side bottom \`
104			`-padx $data(-padx) -pady $data(-pady) \`
105			`-fill x`
106			`pack $data(w:frame) -side bottom \`
107			`-padx $data(-padx) -pady $data(-pady) \`
108			`-expand yes -fill both`
109			`}`
110
111			`proc tixLabelWidget:Pack-left {w} {`
112			`upvar #0 $w data`
113
114			`pack $data(w:label) -side left \`
115			`-padx $data(-padx) -pady $data(-pady) \`
116			`-fill y`
117			`pack $data(w:frame) -side left \`
118			`-padx $data(-padx) -pady $data(-pady) \`
119			`-expand yes -fill both`
120			`}`
121
122			`proc tixLabelWidget:Pack-right {w} {`
123			`upvar #0 $w data`
124
125			`pack $data(w:label) -side right \`
126			`-padx $data(-padx) -pady $data(-pady) \`
127			`-fill x`
128			`pack $data(w:frame) -side right \`
129			`-padx $data(-padx) -pady $data(-pady) \`
130			`-expand yes -fill both`
131			`}`
132
133			`proc tixLabelWidget:Pack-none {w} {`
134			`upvar #0 $w data`
135
136			`pack $data(w:frame)\`
137			`-padx $data(-padx) -pady $data(-pady) \`
138			`-expand yes -fill both`
139			`}`
140
141			`#----------------------------------------------------------------------`
142			`# CONFIG OPTIONS`
143			`#----------------------------------------------------------------------`
144			`proc tixLabelWidget:config-label {w value} {`
145			`upvar #0 $w data`
146
147			`$data(w:label) config -text $value`
148
149			`if {$data(-labelside) == "acrosstop"} {`
150			`tixLabelWidget:Pack-acrosstop $w`
151			`}`
152			`}`

Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tix/] [library/] [LabWidg.tcl] - Blame information for rev 1782