1 # ui-fonts.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1998-2002 The Regents of the University of California.
6 # All rights reserved.
7 #
8 # Redistribution and use in source and binary forms, with or without
9 # modification, are permitted provided that the following conditions are met:
10 #
11 # A. Redistributions of source code must retain the above copyright notice,
12 # this list of conditions and the following disclaimer.
13 # B. Redistributions in binary form must reproduce the above copyright notice,
14 # this list of conditions and the following disclaimer in the documentation
15 # and/or other materials provided with the distribution.
16 # C. Neither the names of the copyright holders nor the names of its
17 # contributors may be used to endorse or promote products derived from this
18 # software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30 #
31 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/applications/mbv2/ui-fonts.tcl,v 1.6 2002/02/03 04:21:59 lim Exp $
32
33
34 import Dialog DropDown
35
36
37 WidgetClass Dialog/SelectFont -superclass Dialog -default {
38 { .borderWidth 1 }
39 { .relief raised }
40 { .cursor arrow }
41 { .modal global }
42 { .transient . }
43 { *Checkbutton.borderWidth 1 }
44 { *Menubutton*borderWidth 1 }
45 { *Checkbutton*font WidgetDefault }
46 { *Menubutton*font WidgetDefault }
47 { *Entry.width 3 }
48 { .highlightThickness 0 }
49 { *DropDown/Text.highlightThickness 0 }
50 } -configspec {
51 { -font font Font {Helvetica 12 bold} config_font }
52 }
53
54
55
56 Dialog/SelectFont public build_widget { path } {
57 wm overrideredirect $path 1
58
59 frame $path.family_size
60 label $path.family_label -text "Family"
61 DropDown $path.family -variable [$self tkvarname family_]
62 $path.family insert end Helvetica Times Courier
63
64 label $path.size_label -text "Size"
65 DropDown/Text $path.size -variable [$self tkvarname size_]
66 $path.size insert end 6 8 10 12 14 16 18 20 24 28 32 36 40
67
68 frame $path.options_sample
69 frame $path.options -bd 2 -relief groove
70 checkbutton $path.weight -text "Bold" -onvalue bold -offvalue normal \
71 -variable [$self tkvarname weight_] -anchor w
72 checkbutton $path.slant -text "Italics" -anchor w -onvalue italic \
73 -offvalue roman -variable [$self tkvarname slant_]
74 checkbutton $path.underline -text "Underline" -onvalue underline \
75 -offvalue "" -variable [$self tkvarname underline_] \
76 -anchor w
77 checkbutton $path.overstrike -text "Overstrike" -onvalue overstrike \
78 -offvalue "" -variable [$self tkvarname overstrike_] \
79 -anchor w
80
81 checkbutton $path.inpixels -text "Size in pixels" -anchor w \
82 -variable [$self tkvarname sizeinpixels_] -pady 0
83 frame $path.sample_frame -bd 2 -relief groove -width 75
84 label $path.sample -text "ABC\nabc" -anchor w -padx 3 -justify left \
85 -font {Helvetica -76 bold italic underline}
86
87 pack $path.family_label -in $path.family_size -side left -fill y
88 pack $path.family -in $path.family_size -side left -fill both -expand 1
89
90 pack $path.size_label -in $path.family_size -side left -fill y
91 pack $path.size -in $path.family_size -side left -fill both -expand 1
92
93 pack $path.family_size -fill x -padx 3 -pady 2
94
95 pack $path.weight $path.slant $path.underline $path.overstrike -fill x\
96 -anchor w -in $path.options
97 pack $path.options -fill x -padx 3 -pady 2 -in $path.options_sample \
98 -side left
99
100 pack $path.sample -in $path.sample_frame -fill both -expand 1
101 pack propagate $path.sample_frame 0
102
103 pack $path.inpixels -side top -fill x -anchor w \
104 -in $path.options_sample
105 pack $path.sample_frame -fill both -expand 1 -padx 3 -pady 2 \
106 -in $path.options_sample -side top
107 pack $path.options_sample -fill x -expand 1 -padx 3 -pady 2
108
109 bind $path <ButtonPress-1> "$self button_down %W %x %y"
110
111 $self tkvar family_ size_ weight_ slant_ underline_ overstrike_ \
112 sizeinpixels_
113 set family_ Helvetica
114 set size_ 12
115 set weight_ bold
116 set slant_ roman
117 set underline_ ""
118 set overstrike_ ""
119 set sizeinpixels_ 0
120
121 trace variable family_ w "$self font_changed"
122 trace variable size_ w "$self font_changed"
123 trace variable weight_ w "$self font_changed"
124 trace variable slant_ w "$self font_changed"
125 trace variable underline_ w "$self font_changed"
126 trace variable overstrike_ w "$self font_changed"
127 trace variable sizeinpixels_ w "$self font_changed"
128
129 $self font_changed
130 }
131
132
133 Dialog/SelectFont public size_in_pixels { flag {never_change 0} } {
134 $self tkvar sizeinpixels_
135 set sizeinpixels_ $flag
136 if $never_change { $self subwidget inpixels configure -state disabled}\
137 else {$self subwidget inpixels configure -state normal}
138 }
139
140
141 Dialog/SelectFont private config_font { option args } {
142 $self tkvar family_ size_ weight_ slant_ underline_ overstrike_ \
143 sizeinpixels_
144 $self instvar font_
145
146 if { [llength $args] == 0 } {
147 return $font_
148 }
149
150 set font [lindex $args 0]
151 set family_ [lindex $font 0]
152 set s [lindex $font 1]
153 if { [string index $s 0] == "-" } {
154 set size_ [string range $s 1 end]
155 set sizeinpixels_ 1
156 } else {
157 set size_ $s
158 set sizeinpixels_ 0
159 }
160
161 foreach style [lrange $font 2 end] {
162 switch -exact -- $style {
163 normal {
164 set weight_ normal
165 set w 1
166 }
167 bold {
168 set weight_ bold
169 set w 1
170 }
171 roman {
172 set slant_ roman
173 set s 1
174 }
175 italic {
176 set slant_ italic
177 set s 1
178 }
179 underline {
180 set underline_ underline
181 set u 1
182 }
183 overstrike {
184 set overstrike_ overstrike
185 set o 1
186 }
187 }
188 }
189
190 if ![info exists w] { set weight_ normal }
191 if ![info exists s] { set slant_ roman }
192 if ![info exists u] { set underline_ "" }
193 if ![info exists o] { set overstrike_ "" }
194
195 $self configure -result $font_
196 }
197
198
199 Dialog/SelectFont private font_changed { args } {
200 $self instvar font_ in_font_changed_
201 $self tkvar family_ size_ weight_ slant_ underline_ overstrike_ \
202 sizeinpixels_
203
204 if [info exists in_font_changed_] return
205 set in_font_changed_ 1
206 if { ![regexp {^[0-9]+$} $size_] } { set size_ 12 } \
207 elseif { $size_ < 4 } { set size_ 4 }
208
209 if $sizeinpixels_ { set s -$size_ } else { set s $size_ }
210
211 set font_ [concat $family_ $s $weight_ $slant_ $underline_ \
212 $overstrike_]
213 $self subwidget sample configure -font $font_
214 unset in_font_changed_
215 }
216
217
218 Dialog/SelectFont private button_down { widget x y } {
219 if { [winfo class $widget] == "Menubutton" } return
220 set path [$self info path]
221 set w [winfo width $path]
222 set h [winfo height $path]
223
224 if { $x < 0 || $x > $w || $y < 0 || $y > $h } {
225 # we are out of the selection region
226 # escape out
227 $self instvar font_
228 $self configure -font $font_
229 }
230 }
231
232
233 Dialog/SelectFont public invoke { {widget {}} {x {}} {y {}} } {
234 $self instvar x_ y_
235 if { $x == {} && $y == {} } {
236 if { $widget == {} } {
237 catch {unset x_ y_}
238 } else {
239 set x_ [expr [winfo rootx $widget]]
240 set y_ [expr [winfo rooty $widget] + \
241 [winfo height $widget]]
242 }
243 } else {
244 set x_ $x
245 set y_ $y
246 }
247
248 $self next
249 }
250
251
252 Dialog/SelectFont public center { } {
253 $self instvar x_ y_
254 if { [info exists x_] && [info exists y_] } {
255 set path [$self info path]
256 wm withdraw $path
257 update idletasks
258 update
259 wm geom $path +$x_+$y_
260 wm deiconify $path
261 raise $path
262 } else {
263 $self next
264 }
265 }
266
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.