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)]] }