1# ---------------------------------------------------------------------------- 2# font.tcl 3# This file is part of Unifix BWidget Toolkit 4# $Id: font.tcl,v 1.18 2009/11/01 20:20:50 oberdorfer Exp $ 5# ---------------------------------------------------------------------------- 6# Index of commands: 7# - SelectFont::create 8# - SelectFont::configure 9# - SelectFont::cget 10# - SelectFont::_draw 11# - SelectFont::_destroy 12# - SelectFont::_modstyle 13# - SelectFont::_update 14# - SelectFont::_getfont 15# - SelectFont::_init 16# - SelectFont::_themechanged 17# ---------------------------------------------------------------------------- 18 19namespace eval SelectFont { 20 Widget::define SelectFont font Dialog LabelFrame ScrolledWindow 21 22 Widget::declare SelectFont { 23 {-title String "Font selection" 0} 24 {-parent String "" 0} 25 {-foreground Color "SystemWindowText" 0} 26 {-background Color "SystemWindow" 0} 27 {-selectbackground Color "SystemHighlight" 0} 28 {-selectforeground Color "SystemHighlightText" 0} 29 {-type Enum dialog 0 {dialog toolbar}} 30 {-font TkResource "" 0 label} 31 {-initialcolor String "" 0} 32 {-families String "all" 1} 33 {-querysystem Boolean 1 0} 34 {-nosizes Boolean 0 1} 35 {-styles String "bold italic underline overstrike" 1} 36 {-command String "" 0} 37 {-sampletext String "Sample Text" 0} 38 {-bg Synonym -background} 39 } 40 41 variable _families 42 variable _styleOff 43 array set _styleOff [list bold normal italic roman] 44 variable _sizes {4 5 6 7 8 9 10 11 12 13 14 15 16 \ 45 17 18 19 20 21 22 23 24} 46 47 # Set up preset lists of fonts, so the user can avoid the painfully slow 48 # loadfont process if desired. 49 if { [string equal $::tcl_platform(platform) "windows"] } { 50 set presetVariable [list \ 51 7x14 \ 52 Arial \ 53 {Arial Narrow} \ 54 {Lucida Sans} \ 55 {MS Sans Serif} \ 56 {MS Serif} \ 57 {Times New Roman} \ 58 ] 59 set presetFixed [list \ 60 6x13 \ 61 {Courier New} \ 62 FixedSys \ 63 Terminal \ 64 ] 65 set presetAll [list \ 66 6x13 \ 67 7x14 \ 68 Arial \ 69 {Arial Narrow} \ 70 {Courier New} \ 71 FixedSys \ 72 {Lucida Sans} \ 73 {MS Sans Serif} \ 74 {MS Serif} \ 75 Terminal \ 76 {Times New Roman} \ 77 ] 78 } else { 79 set presetVariable [list \ 80 helvetica \ 81 lucida \ 82 lucidabright \ 83 {times new roman} \ 84 ] 85 set presetFixed [list \ 86 courier \ 87 fixed \ 88 {lucida typewriter} \ 89 screen \ 90 serif \ 91 terminal \ 92 ] 93 set presetAll [list \ 94 courier \ 95 fixed \ 96 helvetica \ 97 lucida \ 98 lucidabright \ 99 {lucida typewriter} \ 100 screen \ 101 serif \ 102 terminal \ 103 {times new roman} \ 104 ] 105 } 106 array set _families [list \ 107 presetvariable $presetVariable \ 108 presetfixed $presetFixed \ 109 presetall $presetAll \ 110 ] 111 112 if {[lsearch [bindtags .] SelectFontThemeChanged] < 0} { 113 bindtags . [linsert [bindtags .] 1 SelectFontThemeChanged] 114 } 115 116 variable _widget 117} 118 119 120# ---------------------------------------------------------------------------- 121# Command SelectFont::create 122# ---------------------------------------------------------------------------- 123proc SelectFont::create { path args } { 124 variable _families 125 variable _sizes 126 variable $path 127 upvar 0 $path data 128 129 # Initialize the internal rep of the widget options 130 Widget::init SelectFont "$path#SelectFont" $args 131 132 if { [Widget::getoption "$path#SelectFont" -querysystem] } { 133 loadfont [Widget::getoption "$path#SelectFont" -families] 134 } 135 136 set bg [Widget::getoption "$path#SelectFont" -background] 137 set _styles [Widget::getoption "$path#SelectFont" -styles] 138 if { [Widget::getoption "$path#SelectFont" -type] == "dialog" } { 139 140 Dialog::create $path -modal local -anchor e -default 0 -cancel 1 \ 141 -title [Widget::getoption "$path#SelectFont" -title] \ 142 -parent [Widget::getoption "$path#SelectFont" -parent] 143 144 $path configure -background $bg 145 146 set frame [Dialog::getframe $path] 147 148 set topf [frame \ 149 $frame.topf -relief flat -borderwidth 0 \ 150 -background $bg] 151 152 set labf1 [LabelFrame::create $topf.labf1 -text "Font" -name font \ 153 -side top -anchor w -relief flat -background $bg] 154 set sw [ScrolledWindow::create [LabelFrame::getframe $labf1].sw \ 155 -background $bg] 156 set lbf [listbox $sw.lb \ 157 -height 5 -width 25 \ 158 -exportselection false -selectmode browse \ 159 -foreground $BWidget::colors(SystemWindowText) \ 160 -background $BWidget::colors(SystemWindow) \ 161 -selectforeground $BWidget::colors(SystemHighlightText) \ 162 -selectbackground $BWidget::colors(SystemHighlight)] 163 164 ScrolledWindow::setwidget $sw $lbf 165 LabelFrame::configure $labf1 -focus $lbf 166 if { [Widget::getoption "$path#SelectFont" -querysystem] } { 167 set fam [Widget::getoption "$path#SelectFont" -families] 168 } else { 169 set fam "preset" 170 append fam [Widget::getoption "$path#SelectFont" -families] 171 } 172 eval [list $lbf insert end] $_families($fam) 173 set script "set [list SelectFont::${path}(family)] \[%W curselection\];\ 174 SelectFont::_update [list $path]" 175 bind $lbf <ButtonRelease-1> $script 176 bind $lbf <space> $script 177 bind $lbf <1> [list focus %W] 178 bind $lbf <Up> $script 179 bind $lbf <Down> $script 180 pack $sw -fill both -expand yes 181 182 set labf2 [LabelFrame::create $topf.labf2 -text "Size" -name size \ 183 -side top -anchor w -relief flat -background $bg] 184 set sw [ScrolledWindow::create [LabelFrame::getframe $labf2].sw \ 185 -scrollbar vertical -background $bg] 186 set lbs [listbox $sw.lb \ 187 -height 5 -width 6 -exportselection false \ 188 -selectmode browse \ 189 -foreground $BWidget::colors(SystemWindowText) \ 190 -background $BWidget::colors(SystemWindow) \ 191 -selectforeground $BWidget::colors(SystemHighlightText) \ 192 -selectbackground $BWidget::colors(SystemHighlight)] 193 194 ScrolledWindow::setwidget $sw $lbs 195 LabelFrame::configure $labf2 -focus $lbs 196 eval [list $lbs insert end] $_sizes 197 set script "set [list SelectFont::${path}(size)] \[%W curselection\];\ 198 SelectFont::_update [list $path]" 199 bind $lbs <ButtonRelease-1> $script 200 bind $lbs <space> $script 201 bind $lbs <1> [list focus %W] 202 bind $lbs <Up> $script 203 bind $lbs <Down> $script 204 pack $sw -fill both -expand yes 205 206 set labf3 [LabelFrame::create $topf.labf3 -text "Style" -name style \ 207 -side top -anchor w -relief sunken -bd 1 -background $bg] 208 set subf [LabelFrame::getframe $labf3] 209 foreach st $_styles { 210 set name [lindex [BWidget::getname $st] 0] 211 if { $name == "" } { 212 set name [string toupper $name 0] 213 } 214 215 if { [BWidget::using ttk] } { 216 ttk::checkbutton $subf.$st -text $name \ 217 -variable SelectFont::$path\($st\) \ 218 -command [list SelectFont::_update $path] 219 } else { 220 checkbutton $subf.$st -text $name \ 221 -variable SelectFont::$path\($st\) \ 222 -background $bg \ 223 -command [list SelectFont::_update $path] 224 } 225 226 bind $subf.$st <Return> break 227 pack $subf.$st -anchor w -padx 5 228 } 229 LabelFrame::configure $labf3 -focus $subf.[lindex $_styles 0] 230 231 pack $labf1 -side left -anchor n -fill both -expand yes 232 if { ![Widget::getoption "$path#SelectFont" -nosizes] } { 233 pack $labf2 -side left -anchor n -fill both -expand yes -padx 8 234 } 235 pack $labf3 -side left -anchor n -fill both -expand yes 236 237 set botf [frame $frame.botf -width 100 -height 50 \ 238 -bg white -bd 0 -relief flat \ 239 -highlightthickness 1 -takefocus 0 \ 240 -background $BWidget::colors(SystemWindow) \ 241 -highlightbackground $BWidget::colors(SystemWindowText) \ 242 -highlightcolor $BWidget::colors(SystemWindowText)] 243 244 set lab [label $botf.label \ 245 -foreground $BWidget::colors(SystemWindowText) \ 246 -background $BWidget::colors(SystemWindow) \ 247 -borderwidth 0 -takefocus 0 -highlightthickness 0 \ 248 -text [Widget::getoption "$path#SelectFont" -sampletext]] 249 place $lab -relx 0.5 -rely 0.5 -anchor c 250 251 pack $topf -pady 4 -fill both -expand yes 252 253 if { [Widget::getoption "$path#SelectFont" -initialcolor] != ""} { 254 set thecolor [Widget::getoption "$path#SelectFont" -initialcolor] 255 256 set colf [frame $frame.colf] 257 set frc [frame $colf.frame -width 50 -height 20 -bg $thecolor -bd 0 -relief flat\ 258 -highlightthickness 1 -takefocus 0 \ 259 -highlightbackground black \ 260 -highlightcolor black] 261 262 set script "set [list SelectFont::${path}(fontcolor)] \ 263 \[SelectColor::dialog $colf.coldlg -parent $colf.button \ 264 -color \[set [list SelectFont::${path}(fontcolor)]\]\]; \ 265 SelectFont::_update [list $path]" 266 267 set but [Button $colf.button -command $script \ 268 -text "Color..."] 269 270 $lab configure -foreground $thecolor 271 $frc configure -bg $thecolor 272 273 pack $but -side left 274 pack $frc -side left -padx 5 275 276 set data(frc) $frc 277 set data(fontcolor) $thecolor 278 279 pack $colf -pady 4 -fill x -expand true 280 281 } else { 282 set data(fontcolor) -1 283 } 284 pack $botf -pady 4 -fill x 285 286 Dialog::add $path -name ok 287 Dialog::add $path -name cancel 288 289 set data(label) $lab 290 set data(lbf) $lbf 291 set data(lbs) $lbs 292 293 _getfont $path 294 295 Widget::create SelectFont $path 0 296 297 return [_draw $path] 298 } else { 299 if { [Widget::getoption "$path#SelectFont" -querysystem] } { 300 set fams [Widget::getoption "$path#SelectFont" -families] 301 } else { 302 set fams "preset" 303 append fams [Widget::getoption "$path#SelectFont" -families] 304 } 305 if { [BWidget::using ttk] } { 306 ttk::frame $path 307 set lbf [ttk::combobox $path.font \ 308 -takefocus 0 -exportselection 0 \ 309 -values $_families($fams) \ 310 -textvariable SelectFont::${path}(family) \ 311 -state readonly] 312 set lbs [ttk::combobox $path.size \ 313 -takefocus 0 -exportselection 0 \ 314 -width 4 \ 315 -values $_sizes \ 316 -textvariable SelectFont::${path}(size) \ 317 -state readonly] 318 bind $lbf <<ComboboxSelected>> [list SelectFont::_update $path] 319 bind $lbs <<ComboboxSelected>> [list SelectFont::_update $path] 320 } else { 321 frame $path -background $bg 322 set lbf [ComboBox::create $path.font \ 323 -highlightthickness 0 -takefocus 0 -background $bg \ 324 -values $_families($fams) \ 325 -textvariable SelectFont::$path\(family\) \ 326 -editable 0 \ 327 -modifycmd [list SelectFont::_update $path] \ 328 -hottrack 1] 329 set lbs [ComboBox::create $path.size \ 330 -highlightthickness 0 -takefocus 0 -background $bg \ 331 -width 4 \ 332 -values $_sizes \ 333 -textvariable SelectFont::$path\(size\) \ 334 -editable 0 \ 335 -modifycmd [list SelectFont::_update $path] \ 336 -hottrack 1] 337 } 338 bind $path <Destroy> [list SelectFont::_destroy $path] 339 pack $lbf -side left -anchor w 340 pack $lbs -side left -anchor w -padx 4 341 foreach st $_styles { 342 if { [BWidget::using ttk] } { 343 ttk::checkbutton $path.$st -takefocus 0 \ 344 -image [Bitmap::get $st] \ 345 -variable SelectFont::${path}($st) \ 346 -command [list SelectFont::_update $path] \ 347 -style [Button::getSlimButtonStyle] 348 } else { 349 button $path.$st \ 350 -highlightthickness 0 -takefocus 0 -padx 0 -pady 0 \ 351 -background $bg \ 352 -image [Bitmap::get $st] \ 353 -command [list SelectFont::_modstyle $path $st] 354 } 355 pack $path.$st -side left -anchor w 356 } 357 set data(label) "" 358 set data(lbf) $lbf 359 set data(lbs) $lbs 360 _getfont $path 361 362 bind SelectFontThemeChanged <<ThemeChanged>> \ 363 "+ [namespace current]::_themechanged $path" 364 365 return [Widget::create SelectFont $path] 366 } 367 368 return $path 369} 370 371 372# ---------------------------------------------------------------------------- 373# Command SelectFont::configure 374# ---------------------------------------------------------------------------- 375proc SelectFont::configure { path args } { 376 set _styles [Widget::getoption "$path#SelectFont" -styles] 377 378 set res [Widget::configure "$path#SelectFont" $args] 379 380 if { [Widget::hasChanged "$path#SelectFont" -font font] } { 381 _getfont $path 382 } 383 if { [Widget::hasChanged "$path#SelectFont" -background bg] } { 384 switch -- [Widget::getoption "$path#SelectFont" -type] { 385 dialog { 386 Dialog::configure $path -background $bg 387 set topf [Dialog::getframe $path].topf 388 $topf configure -background $bg 389 foreach labf {labf1 labf2} { 390 LabelFrame::configure $topf.$labf -background $bg 391 set subf [LabelFrame::getframe $topf.$labf] 392 ScrolledWindow::configure $subf.sw -background $bg 393 $subf.sw.lb configure -background $bg 394 } 395 LabelFrame::configure $topf.labf3 -background $bg 396 set subf [LabelFrame::getframe $topf.labf3] 397 foreach w [winfo children $subf] { 398 $w configure -background $bg 399 } 400 } 401 toolbar { 402 if { ![BWidget::using ttk] } { 403 $path:cmd configure -background $bg 404 ComboBox::configure $path.font -background $bg 405 ComboBox::configure $path.size -background $bg 406 foreach st $_styles { 407 $path.$st configure -background $bg 408 } 409 } 410 } 411 } 412 } 413 return $res 414} 415 416 417# ---------------------------------------------------------------------------- 418# Command SelectFont::cget 419# ---------------------------------------------------------------------------- 420proc SelectFont::cget { path option } { 421 return [Widget::cget "$path#SelectFont" $option] 422} 423 424 425# ---------------------------------------------------------------------------- 426# Command SelectFont::loadfont 427# ---------------------------------------------------------------------------- 428proc SelectFont::loadfont {{which all}} { 429 variable _families 430 431 # initialize families 432 if {![info exists _families(all)]} { 433 set _families(all) [lsort -dictionary [font families]] 434 } 435 if {[regexp {fixed|variable} $which] \ 436 && ![info exists _families($which)]} { 437 # initialize families 438 set _families(fixed) {} 439 set _families(variable) {} 440 foreach family $_families(all) { 441 if { [font metrics [list $family] -fixed] } { 442 lappend _families(fixed) $family 443 } else { 444 lappend _families(variable) $family 445 } 446 } 447 } 448 return 449} 450 451 452# ---------------------------------------------------------------------------- 453# Command SelectFont::_draw 454# ---------------------------------------------------------------------------- 455proc SelectFont::_draw { path } { 456 variable $path 457 upvar 0 $path data 458 459 $data(lbf) selection clear 0 end 460 $data(lbf) selection set $data(family) 461 $data(lbf) activate $data(family) 462 $data(lbf) see $data(family) 463 $data(lbs) selection clear 0 end 464 $data(lbs) selection set $data(size) 465 $data(lbs) activate $data(size) 466 $data(lbs) see $data(size) 467 _update $path 468 469 if { [Dialog::draw $path] == 0 } { 470 set result [Widget::getoption "$path#SelectFont" -font] 471 set color $data(fontcolor) 472 473 if { $color == "" } { 474 set color #000000 475 } 476 477 } else { 478 set result "" 479 if {$data(fontcolor) == -1} { 480 set color -1 481 } else { 482 set color "" 483 } 484 } 485 unset data 486 Widget::destroy "$path#SelectFont" 487 destroy $path 488 if { $color != -1 } { 489 return [list $result $color] 490 } else { 491 return $result 492 } 493} 494 495 496# ---------------------------------------------------------------------------- 497# Command SelectFont::_modstyle 498# ---------------------------------------------------------------------------- 499proc SelectFont::_modstyle { path style } { 500 variable $path 501 upvar 0 $path data 502 503 $path.$style configure -relief [expr {$data($style) ? "raised" : "sunken"}] 504 set data($style) [expr {!$data($style)}] 505 _update $path 506} 507 508 509# ---------------------------------------------------------------------------- 510# Command SelectFont::_update 511# ---------------------------------------------------------------------------- 512proc SelectFont::_update { path } { 513 variable _families 514 variable _sizes 515 variable _styleOff 516 variable $path 517 upvar 0 $path data 518 519 set type [Widget::getoption "$path#SelectFont" -type] 520 set _styles [Widget::getoption "$path#SelectFont" -styles] 521 if { [Widget::getoption "$path#SelectFont" -querysystem] } { 522 set fams [Widget::getoption "$path#SelectFont" -families] 523 } else { 524 set fams "preset" 525 append fams [Widget::getoption "$path#SelectFont" -families] 526 } 527 if { $type == "dialog" } { 528 set curs [$path:cmd cget -cursor] 529 $path:cmd configure -cursor watch 530 } 531 if { [Widget::getoption "$path#SelectFont" -type] == "dialog" } { 532 set font [list [lindex $_families($fams) $data(family)] \ 533 [lindex $_sizes $data(size)]] 534 } else { 535 set font [list $data(family) $data(size)] 536 } 537 foreach st $_styles { 538 if { $data($st) } { 539 lappend font $st 540 } elseif {[info exists _styleOff($st)]} { 541 # This adds the default bold/italic value to a font 542 #lappend font $_styleOff($st) 543 } 544 } 545 Widget::setoption "$path#SelectFont" -font $font 546 if { $type == "dialog" } { 547 $data(label) configure -font $font 548 $path:cmd configure -cursor $curs 549 if { ($data(fontcolor) != "") && ($data(fontcolor) != -1) } { 550 $data(label) configure -foreground $data(fontcolor) 551 $data(frc) configure -bg $data(fontcolor) 552 } elseif { $data(fontcolor) == "" } { 553 #If no color is selected, restore previous one 554 set data(fontcolor) [$data(label) cget -foreground] 555 556 } 557 } elseif { [set cmd [Widget::getoption "$path#SelectFont" -command]] != "" } { 558 uplevel \#0 $cmd 559 } 560} 561 562 563# ---------------------------------------------------------------------------- 564# Command SelectFont::_getfont 565# ---------------------------------------------------------------------------- 566proc SelectFont::_getfont { path } { 567 variable _families 568 variable _sizes 569 variable $path 570 upvar 0 $path data 571 572 array set font [font actual [Widget::getoption "$path#SelectFont" -font]] 573 set data(bold) [expr {![string equal $font(-weight) "normal"]}] 574 set data(italic) [expr {![string equal $font(-slant) "roman"]}] 575 set data(underline) $font(-underline) 576 set data(overstrike) $font(-overstrike) 577 set _styles [Widget::getoption "$path#SelectFont" -styles] 578 if { [Widget::getoption "$path#SelectFont" -querysystem] } { 579 set fams [Widget::getoption "$path#SelectFont" -families] 580 } else { 581 set fams "preset" 582 append fams [Widget::getoption "$path#SelectFont" -families] 583 } 584 if { [Widget::getoption "$path#SelectFont" -type] == "dialog" } { 585 set idxf [lsearch $_families($fams) $font(-family)] 586 set idxs [lsearch $_sizes $font(-size)] 587 set data(family) [expr {$idxf >= 0 ? $idxf : 0}] 588 set data(size) [expr {$idxs >= 0 ? $idxs : 0}] 589 } else { 590 set data(family) $font(-family) 591 set data(size) $font(-size) 592 if { ![BWidget::using ttk] } { 593 foreach st $_styles { 594 $path.$st configure \ 595 -relief [expr {$data($st) ? "sunken":"raised"}] 596 } 597 } 598 } 599} 600 601 602# ---------------------------------------------------------------------------- 603# Command SelectFont::_destroy 604# ---------------------------------------------------------------------------- 605proc SelectFont::_destroy { path } { 606 variable $path 607 upvar 0 $path data 608 unset data 609 Widget::destroy "$path#SelectFont" 610} 611 612# ---------------------------------------------------------------------------- 613# Command SelectFont::_themechanged 614# ---------------------------------------------------------------------------- 615proc SelectFont::_themechanged { path } { 616 if { ![winfo exists $path] } { return } 617 BWidget::set_themedefaults 618 $path configure -background $BWidget::colors(SystemWindowFrame) 619} 620 621