tkgoodstuff/tcl/prefs-browsers.tcl

142 lines
4.1 KiB
Tcl
Raw Permalink Normal View History

proc PrefsWidget-color {var w} {
global TKGVars $var
set f [frame $w.widget$var]
grid columnconfigure $f 0 -weight 1
set e [entry $f.entry -width 15 -textvariable TKGVars($var,setting)]
grid $e -sticky nsew
if [info exists TKGVars($var,scrollbar)] {
$f configure -relief ridge -bd 2
set s [scrollbar $f.sb -orient horizontal -width 8 \
-command "$e xview" -takefocus 0]
$e configure -xscrollcommand "$s set"
grid $s -sticky nsew
}
grid [button $f.color -text browse \
-command "PrefsColorBrowse $var"]\
-row 0 -column 1
trace variable TKGVars($var,setting) w "PrefsColorSet $var $f"
TKGAddToHook Prefs_updatehook \
"trace vdelete TKGVars($var,setting) w \"PrefsColorSet $var $f\""
set TKGVars($var,setting) $TKGVars($var,setting)
}
proc PrefsColorBrowse {var} {
global TKGVars
if {![Empty [set c [tk_chooseColor]]]} {
set TKGVars($var,setting) $c
}
}
proc PrefsColorSet {var frame args} {
global TKGVars TKG
if [Empty $TKGVars($var,setting)] {
set c [$frame cget -background]
set h $c
set r raised
} else {
eval set c $TKGVars($var,setting)
set r flat
set h $TKG(foreground)
}
$frame.color config -background $c -activebackground $c -relief $r \
-highlightbackground $h
}
proc PrefsWidget-font {var w} {
global TKGVars $var
set f [frame $w.widget$var]
grid columnconfigure $f 0 -weight 1
set e [entry $f.entry -width 35 -textvariable TKGVars($var,setting)]
grid $e -sticky nsew
if [info exists TKGVars($var,scrollbar)] {
$f configure -relief ridge -bd 2
set s [scrollbar $f.sb -orient horizontal -width 8 \
-command "$e xview" -takefocus 0]
$e configure -xscrollcommand "$s set"
grid $s -sticky nsew
}
grid [button $f.font -text browse \
-command "PrefsFontBrowse $var"]\
-row 0 -column 1
trace variable TKGVars($var,setting) w "PrefsFontSet $var $f"
TKGAddToHook Prefs_updatehook \
"trace vdelete TKGVars($var,setting) w \"PrefsFontSet $var $f\""
set TKGVars($var,setting) $TKGVars($var,setting)
}
proc PrefsFontBrowse {var} {
global TKGVars
if {![Empty [set c [TKGChooseFont $TKGVars($var,setting)]]]} {
set TKGVars($var,setting) $c
}
}
proc PrefsFontSet {var frame args} {
global TKGVars TKG
if [Empty $TKGVars($var,setting)] {
set f $TKG(generalfont)
} else {
set f $TKGVars($var,setting)
}
$frame.font config -font $f
}
proc TKGChooseFont {font} {
global TKG
set w .choosefont
set familys [font families]
set sizes {6 8 9 10 11 12 14 16 18 20 24}
set slants {roman italic}
set weights {normal bold}
TKGDialog choosefont \
-title "Select Font" -wmtitle "Select Font"\
-nodeiconify -nodismiss\
-buttons {
{ok OK {destroy .choosefont}}
{cancel Cancel {set TKG(chooserfont) $TKG(origfont); destroy .choosefont}}
}
set TKG(origfont) $font
grid [frame $w.optbuts] -row 2
label $w.sample -text "Here is a SAMPLE of the font."
catch {$w.sample configure -font $font}
set font [$w.sample cget -font]
catch {font create fontchooser}
foreach param {family size slant weight} {
font configure fontchooser -$param \
[font actual $font -$param]
set TKG(choosefont.$param) [font actual $font -$param]
eval tk_optionMenu $w.optbuts.$param TKG(choosefont.$param) [set ${param}s]
}
$w.sample configure -font fontchooser
grid $w.optbuts.family $w.optbuts.size $w.optbuts.slant $w.optbuts.weight -row 2
grid $w.sample -row 3 -rowspan 3
foreach param {family size slant weight} {
trace variable TKG(choosefont.$param) w TKGChooseFontUpdate
}
set TKG(chooserfont) $font
TKGCenter $w
tkwait window $w
return $TKG(chooserfont)
}
proc TKGChooseFontUpdate {args} {
global TKG
update
set params {family size slant weight}
foreach param $params {
set val $TKG(choosefont.$param)
if {[catch {font configure fontchooser -$param $val}]} {
set val [font configure fontchooser -$param]
set TKG(choosefont.$param) $val
}
}
set TKG(chooserfont) [list $TKG(choosefont.family) \
$TKG(choosefont.size) \
[list $TKG(choosefont.slant) \
$TKG(choosefont.weight)]]
}