diff options
Diffstat (limited to 'library/fontchooser.tcl')
| -rw-r--r-- | library/fontchooser.tcl | 542 |
1 files changed, 271 insertions, 271 deletions
diff --git a/library/fontchooser.tcl b/library/fontchooser.tcl index 3aaa6b7..c53d1d6 100644 --- a/library/fontchooser.tcl +++ b/library/fontchooser.tcl @@ -14,10 +14,10 @@ namespace eval ::tk::fontchooser { set S(W) .__tk__fontchooser set S(fonts) [lsort -dictionary -unique [font families]] set S(styles) [list \ - [::msgcat::mc Regular] \ - [::msgcat::mc Italic] \ - [::msgcat::mc Bold] \ - [::msgcat::mc {Bold Italic}] \ + [::msgcat::mc Regular] \ + [::msgcat::mc Italic] \ + [::msgcat::mc Bold] \ + [::msgcat::mc {Bold Italic}] \ ] set S(sizes) {8 9 10 11 12 14 16 18 20 22 24 26 28 36 48 72} set S(strike) 0 @@ -34,7 +34,7 @@ proc ::tk::fontchooser::Canonical {} { variable S foreach style $S(styles) { - lappend S(styles,lcase) [string tolower $style] + lappend S(styles,lcase) [string tolower $style] } set S(sizes,lcase) $S(sizes) set S(sampletext) [::msgcat::mc "AaBbYyZz01"] @@ -42,11 +42,11 @@ proc ::tk::fontchooser::Canonical {} { # Canonical versions of font families, styles, etc. for easier searching set S(fonts,lcase) {} foreach font $S(fonts) { - lappend S(fonts,lcase) [string tolower $font] + lappend S(fonts,lcase) [string tolower $font] } set S(styles,lcase) {} foreach style $S(styles) { - lappend S(styles,lcase) [string tolower $style] + lappend S(styles,lcase) [string tolower $style] } } @@ -56,18 +56,18 @@ proc ::tk::fontchooser::Setup {} { Canonical ::ttk::style layout FontchooserFrame { - Entry.field -sticky news -border true -children { - FontchooserFrame.padding -sticky news - } + Entry.field -sticky news -border true -children { + FontchooserFrame.padding -sticky news + } } bind [winfo class .] <<ThemeChanged>> \ - [list +ttk::style layout FontchooserFrame \ - [ttk::style layout FontchooserFrame]] + [list +ttk::style layout FontchooserFrame \ + [ttk::style layout FontchooserFrame]] namespace ensemble create -map { - show ::tk::fontchooser::Show - hide ::tk::fontchooser::Hide - configure ::tk::fontchooser::Configure + show ::tk::fontchooser::Show + hide ::tk::fontchooser::Hide + configure ::tk::fontchooser::Configure } } ::tk::fontchooser::Setup @@ -78,19 +78,19 @@ proc ::tk::fontchooser::Show {} { Canonical if {![winfo exists $S(W)]} { - Create - wm transient $S(W) [winfo toplevel $S(-parent)] - tk::PlaceWindow $S(W) widget $S(-parent) - if {[string trim $S(-title)] eq ""} { - wm title $S(W) [::msgcat::mc "Font"] - } else { - wm title $S(W) $S(-title) - } + Create + wm transient $S(W) [winfo toplevel $S(-parent)] + tk::PlaceWindow $S(W) widget $S(-parent) + if {[string trim $S(-title)] eq ""} { + wm title $S(W) [::msgcat::mc "Font"] + } else { + wm title $S(W) $S(-title) + } } set S(fonts) [lsort -dictionary -unique [font families]] set S(fonts,lcase) {} foreach font $S(fonts) { - lappend S(fonts,lcase) [string tolower $font] + lappend S(fonts,lcase) [string tolower $font] } wm deiconify $S(W) } @@ -104,57 +104,57 @@ proc ::tk::fontchooser::Configure {args} { variable S set specs { - {-parent "" "" . } - {-title "" "" ""} - {-font "" "" ""} - {-command "" "" ""} + {-parent "" "" . } + {-title "" "" ""} + {-font "" "" ""} + {-command "" "" ""} } if {[llength $args] == 0} { - set result {} - foreach spec $specs { - foreach {name xx yy default} $spec break - lappend result $name \ - [expr {[info exists S($name)] ? $S($name) : $default}] - } - lappend result -visible \ - [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}] - return $result + set result {} + foreach spec $specs { + foreach {name xx yy default} $spec break + lappend result $name \ + [expr {[info exists S($name)] ? $S($name) : $default}] + } + lappend result -visible \ + [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}] + return $result } if {[llength $args] == 1} { - set option [lindex $args 0] - if {[string equal $option "-visible"]} { - return [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}] - } elseif {[info exists S($option)]} { - return $S($option) - } - return -code error -errorcode [list TK LOOKUP OPTION $option] \ - "bad option \"$option\": must be\ - -command, -font, -parent, -title or -visible" + set option [lindex $args 0] + if {[string equal $option "-visible"]} { + return [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}] + } elseif {[info exists S($option)]} { + return $S($option) + } + return -code error -errorcode [list TK LOOKUP OPTION $option] \ + "bad option \"$option\": must be\ + -command, -font, -parent, -title or -visible" } set cache [dict create -parent $S(-parent) -title $S(-title) \ - -font $S(-font) -command $S(-command)] + -font $S(-font) -command $S(-command)] set r [tclParseConfigSpec [namespace which -variable S] $specs DONTSETDEFAULTS $args] if {![winfo exists $S(-parent)]} { - set code [list TK LOOKUP WINDOW $S(-parent)] - set err "bad window path name \"$S(-parent)\"" - array set S $cache - return -code error -errorcode $code $err + set code [list TK LOOKUP WINDOW $S(-parent)] + set err "bad window path name \"$S(-parent)\"" + array set S $cache + return -code error -errorcode $code $err } if {[winfo exists $S(W)]} { - if {{-font} in $args} { - Init $S(-font) - event generate $S(-parent) <<TkFontchooserFontChanged>> - } - - if {[string trim $S(-title)] eq {}} { - wm title $S(W) [::msgcat::mc Font] - } else { - wm title $S(W) $S(-title) - } - $S(W).ok configure -state $S(nstate) - $S(W).apply configure -state $S(nstate) + if {{-font} in $args} { + Init $S(-font) + event generate $S(-parent) <<TkFontchooserFontChanged>> + } + + if {[string trim $S(-title)] eq {}} { + wm title $S(W) [::msgcat::mc Font] + } else { + wm title $S(W) $S(-title) + } + $S(W).ok configure -state $S(nstate) + $S(W).apply configure -state $S(nstate) } return $r } @@ -163,144 +163,144 @@ proc ::tk::fontchooser::Create {} { variable S set windowName __tk__fontchooser if {$S(-parent) eq "."} { - set S(W) .$windowName + set S(W) .$windowName } else { - set S(W) $S(-parent).$windowName + set S(W) $S(-parent).$windowName } # Now build the dialog if {![winfo exists $S(W)]} { - toplevel $S(W) -class TkFontDialog - if {[package provide tcltest] ne {}} { - set ::tk_dialog $S(W) - } - wm withdraw $S(W) - wm title $S(W) $S(-title) - wm transient $S(W) [winfo toplevel $S(-parent)] - - set outer [::ttk::frame $S(W).outer -padding {7.5p 7.5p}] - ::tk::AmpWidget ::ttk::label $S(W).font -text [::msgcat::mc "&Font:"] - ::tk::AmpWidget ::ttk::label $S(W).style -text [::msgcat::mc "Font st&yle:"] - ::tk::AmpWidget ::ttk::label $S(W).size -text [::msgcat::mc "&Size:"] - ttk::entry $S(W).efont -width 18 \ - -textvariable [namespace which -variable S](font) - ttk::entry $S(W).estyle -width 10 \ - -textvariable [namespace which -variable S](style) - ttk::entry $S(W).esize -textvariable [namespace which -variable S](size) \ - -width 3 -validate key -validatecommand {regexp -- {^-*[0-9]*$} %P} - - ttk_slistbox $S(W).lfonts -height 7 -exportselection 0 \ - -selectmode browse -activestyle none \ - -listvariable [namespace which -variable S](fonts) - ttk_slistbox $S(W).lstyles -width 5 -height 7 -exportselection 0 \ - -selectmode browse -activestyle none \ - -listvariable [namespace which -variable S](styles) - ttk_slistbox $S(W).lsizes -width 4 -height 7 -exportselection 0 \ - -selectmode browse -activestyle none \ - -listvariable [namespace which -variable S](sizes) - - set WE $S(W).effects - ::ttk::labelframe $WE -text [::msgcat::mc "Effects"] - ::tk::AmpWidget ::ttk::checkbutton $WE.strike \ - -variable [namespace which -variable S](strike) \ - -text [::msgcat::mc "Stri&keout"] \ - -command [namespace code [list Click strike]] - ::tk::AmpWidget ::ttk::checkbutton $WE.under \ - -variable [namespace which -variable S](under) \ - -text [::msgcat::mc "&Underline"] \ - -command [namespace code [list Click under]] - - set bbox [::ttk::frame $S(W).bbox] - ::ttk::button $S(W).ok -text [::msgcat::mc OK] -default active\ - -command [namespace code [list Done 1]] - ::ttk::button $S(W).cancel -text [::msgcat::mc Cancel] \ - -command [namespace code [list Done 0]] - ::tk::AmpWidget ::ttk::button $S(W).apply -text [::msgcat::mc "&Apply"] \ - -command [namespace code [list Apply]] - wm protocol $S(W) WM_DELETE_WINDOW [namespace code [list Done 0]] - - # Calculate minimum sizes - ttk::scrollbar $S(W).tmpvs - set scroll_width [winfo reqwidth $S(W).tmpvs] - destroy $S(W).tmpvs - set minsize(gap) [::tk::ScaleNum 10] - set minsize(bbox) [winfo reqwidth $S(W).ok] - set minsize(fonts) \ - [expr {[font measure TkDefaultFont "Helvetica"] + $scroll_width}] - set minsize(styles) \ - [expr {[font measure TkDefaultFont "Bold Italic"] + $scroll_width}] - set minsize(sizes) \ - [expr {[font measure TkDefaultFont "-99"] + $scroll_width}] - set min [expr {$minsize(gap) * 4}] - foreach {what width} [array get minsize] { - incr min $width - } - wm minsize $S(W) $min [::tk::ScaleNum 260] - - bind $S(W) <Return> [namespace code [list Done 1]] - bind $S(W) <Escape> [namespace code [list Done 0]] - bind $S(W) <Map> [namespace code [list Visibility %W 1]] - bind $S(W) <Unmap> [namespace code [list Visibility %W 0]] - bind $S(W) <Destroy> [namespace code [list Visibility %W 0]] - bind $S(W).lfonts.list <<ListboxSelect>> [namespace code [list Click font]] - bind $S(W).lstyles.list <<ListboxSelect>> [namespace code [list Click style]] - bind $S(W).lsizes.list <<ListboxSelect>> [namespace code [list Click size]] - bind $S(W) <Alt-Key> [list ::tk::AltKeyInDialog $S(W) %A] - bind $S(W).font <<AltUnderlined>> [list ::focus $S(W).efont] - bind $S(W).style <<AltUnderlined>> [list ::focus $S(W).estyle] - bind $S(W).size <<AltUnderlined>> [list ::focus $S(W).esize] - bind $S(W).apply <<AltUnderlined>> [namespace code [list Apply]] - bind $WE.strike <<AltUnderlined>> [list $WE.strike invoke] - bind $WE.under <<AltUnderlined>> [list $WE.under invoke] - - set WS $S(W).sample - ::ttk::labelframe $WS -text [::msgcat::mc "Sample"] - ::ttk::label $WS.sample -relief sunken -anchor center \ - -textvariable [namespace which -variable S](sampletext) - set S(sample) $WS.sample - grid $WS.sample -sticky news -padx 4.5p -pady 3p - grid rowconfigure $WS 0 -weight 1 - grid columnconfigure $WS 0 -weight 1 - grid propagate $WS 0 - - grid $S(W).ok -in $bbox -sticky new -pady {0 1.5p} - grid $S(W).cancel -in $bbox -sticky new -pady 1.5p - grid $S(W).apply -in $bbox -sticky new -pady 1.5p - grid columnconfigure $bbox 0 -weight 1 - - grid $WE.strike -sticky w -padx 7.5p - grid $WE.under -sticky w -padx 7.5p -pady {0 22.5p} - grid columnconfigure $WE 1 -weight 1 - - grid $S(W).font x $S(W).style x $S(W).size x -in $outer -sticky w - grid $S(W).efont x $S(W).estyle x $S(W).esize x $bbox -in $outer -sticky ew - grid $S(W).lfonts x $S(W).lstyles x $S(W).lsizes x ^ -in $outer -sticky news - grid $WE x $WS - - x ^ -in $outer -sticky news -pady {11p 22.5p} - grid configure $bbox -sticky n - grid rowconfigure $outer 2 -weight 1 - grid columnconfigure $outer {1 3 5} -minsize $minsize(gap) - grid columnconfigure $outer {0 2 4} -weight 1 - grid columnconfigure $outer 0 -minsize $minsize(fonts) - grid columnconfigure $outer 2 -minsize $minsize(styles) - grid columnconfigure $outer 4 -minsize $minsize(sizes) - grid columnconfigure $outer 6 -minsize $minsize(bbox) - - grid $outer -sticky news - grid rowconfigure $S(W) 0 -weight 1 - grid columnconfigure $S(W) 0 -weight 1 - - Init $S(-font) - - trace add variable [namespace which -variable S](size) \ - write [namespace code [list Tracer]] - trace add variable [namespace which -variable S](style) \ - write [namespace code [list Tracer]] - trace add variable [namespace which -variable S](font) \ - write [namespace code [list Tracer]] - trace add variable [namespace which -variable S](strike) \ - write [namespace code [list Tracer]] - trace add variable [namespace which -variable S](under) \ - write [namespace code [list Tracer]] + toplevel $S(W) -class TkFontDialog + if {[package provide tcltest] ne {}} { + set ::tk_dialog $S(W) + } + wm withdraw $S(W) + wm title $S(W) $S(-title) + wm transient $S(W) [winfo toplevel $S(-parent)] + + set outer [::ttk::frame $S(W).outer -padding {7.5p 7.5p}] + ::tk::AmpWidget ::ttk::label $S(W).font -text [::msgcat::mc "&Font:"] + ::tk::AmpWidget ::ttk::label $S(W).style -text [::msgcat::mc "Font st&yle:"] + ::tk::AmpWidget ::ttk::label $S(W).size -text [::msgcat::mc "&Size:"] + ttk::entry $S(W).efont -width 18 \ + -textvariable [namespace which -variable S](font) + ttk::entry $S(W).estyle -width 10 \ + -textvariable [namespace which -variable S](style) + ttk::entry $S(W).esize -textvariable [namespace which -variable S](size) \ + -width 3 -validate key -validatecommand {regexp -- {^-*[0-9]*$} %P} + + ttk_slistbox $S(W).lfonts -height 7 -exportselection 0 \ + -selectmode browse -activestyle none \ + -listvariable [namespace which -variable S](fonts) + ttk_slistbox $S(W).lstyles -width 5 -height 7 -exportselection 0 \ + -selectmode browse -activestyle none \ + -listvariable [namespace which -variable S](styles) + ttk_slistbox $S(W).lsizes -width 4 -height 7 -exportselection 0 \ + -selectmode browse -activestyle none \ + -listvariable [namespace which -variable S](sizes) + + set WE $S(W).effects + ::ttk::labelframe $WE -text [::msgcat::mc "Effects"] + ::tk::AmpWidget ::ttk::checkbutton $WE.strike \ + -variable [namespace which -variable S](strike) \ + -text [::msgcat::mc "Stri&keout"] \ + -command [namespace code [list Click strike]] + ::tk::AmpWidget ::ttk::checkbutton $WE.under \ + -variable [namespace which -variable S](under) \ + -text [::msgcat::mc "&Underline"] \ + -command [namespace code [list Click under]] + + set bbox [::ttk::frame $S(W).bbox] + ::ttk::button $S(W).ok -text [::msgcat::mc OK] -default active\ + -command [namespace code [list Done 1]] + ::ttk::button $S(W).cancel -text [::msgcat::mc Cancel] \ + -command [namespace code [list Done 0]] + ::tk::AmpWidget ::ttk::button $S(W).apply -text [::msgcat::mc "&Apply"] \ + -command [namespace code [list Apply]] + wm protocol $S(W) WM_DELETE_WINDOW [namespace code [list Done 0]] + + # Calculate minimum sizes + ttk::scrollbar $S(W).tmpvs + set scroll_width [winfo reqwidth $S(W).tmpvs] + destroy $S(W).tmpvs + set minsize(gap) [::tk::ScaleNum 10] + set minsize(bbox) [winfo reqwidth $S(W).ok] + set minsize(fonts) \ + [expr {[font measure TkDefaultFont "Helvetica"] + $scroll_width}] + set minsize(styles) \ + [expr {[font measure TkDefaultFont "Bold Italic"] + $scroll_width}] + set minsize(sizes) \ + [expr {[font measure TkDefaultFont "-99"] + $scroll_width}] + set min [expr {$minsize(gap) * 4}] + foreach {what width} [array get minsize] { + incr min $width + } + wm minsize $S(W) $min [::tk::ScaleNum 260] + + bind $S(W) <Return> [namespace code [list Done 1]] + bind $S(W) <Escape> [namespace code [list Done 0]] + bind $S(W) <Map> [namespace code [list Visibility %W 1]] + bind $S(W) <Unmap> [namespace code [list Visibility %W 0]] + bind $S(W) <Destroy> [namespace code [list Visibility %W 0]] + bind $S(W).lfonts.list <<ListboxSelect>> [namespace code [list Click font]] + bind $S(W).lstyles.list <<ListboxSelect>> [namespace code [list Click style]] + bind $S(W).lsizes.list <<ListboxSelect>> [namespace code [list Click size]] + bind $S(W) <Alt-Key> [list ::tk::AltKeyInDialog $S(W) %A] + bind $S(W).font <<AltUnderlined>> [list ::focus $S(W).efont] + bind $S(W).style <<AltUnderlined>> [list ::focus $S(W).estyle] + bind $S(W).size <<AltUnderlined>> [list ::focus $S(W).esize] + bind $S(W).apply <<AltUnderlined>> [namespace code [list Apply]] + bind $WE.strike <<AltUnderlined>> [list $WE.strike invoke] + bind $WE.under <<AltUnderlined>> [list $WE.under invoke] + + set WS $S(W).sample + ::ttk::labelframe $WS -text [::msgcat::mc "Sample"] + ::ttk::label $WS.sample -relief sunken -anchor center \ + -textvariable [namespace which -variable S](sampletext) + set S(sample) $WS.sample + grid $WS.sample -sticky news -padx 4.5p -pady 3p + grid rowconfigure $WS 0 -weight 1 + grid columnconfigure $WS 0 -weight 1 + grid propagate $WS 0 + + grid $S(W).ok -in $bbox -sticky new -pady {0 1.5p} + grid $S(W).cancel -in $bbox -sticky new -pady 1.5p + grid $S(W).apply -in $bbox -sticky new -pady 1.5p + grid columnconfigure $bbox 0 -weight 1 + + grid $WE.strike -sticky w -padx 7.5p + grid $WE.under -sticky w -padx 7.5p -pady {0 22.5p} + grid columnconfigure $WE 1 -weight 1 + + grid $S(W).font x $S(W).style x $S(W).size x -in $outer -sticky w + grid $S(W).efont x $S(W).estyle x $S(W).esize x $bbox -in $outer -sticky ew + grid $S(W).lfonts x $S(W).lstyles x $S(W).lsizes x ^ -in $outer -sticky news + grid $WE x $WS - - x ^ -in $outer -sticky news -pady {11p 22.5p} + grid configure $bbox -sticky n + grid rowconfigure $outer 2 -weight 1 + grid columnconfigure $outer {1 3 5} -minsize $minsize(gap) + grid columnconfigure $outer {0 2 4} -weight 1 + grid columnconfigure $outer 0 -minsize $minsize(fonts) + grid columnconfigure $outer 2 -minsize $minsize(styles) + grid columnconfigure $outer 4 -minsize $minsize(sizes) + grid columnconfigure $outer 6 -minsize $minsize(bbox) + + grid $outer -sticky news + grid rowconfigure $S(W) 0 -weight 1 + grid columnconfigure $S(W) 0 -weight 1 + + Init $S(-font) + + trace add variable [namespace which -variable S](size) \ + write [namespace code [list Tracer]] + trace add variable [namespace which -variable S](style) \ + write [namespace code [list Tracer]] + trace add variable [namespace which -variable S](font) \ + write [namespace code [list Tracer]] + trace add variable [namespace which -variable S](strike) \ + write [namespace code [list Tracer]] + trace add variable [namespace which -variable S](under) \ + write [namespace code [list Tracer]] } Init $S(-font) @@ -319,7 +319,7 @@ proc ::tk::fontchooser::Done {ok} { variable S if {! $ok} { - set S(result) "" + set S(result) "" } trace remove variable S(size) write [namespace code [list Tracer]] trace remove variable S(style) write [namespace code [list Tracer]] @@ -328,10 +328,10 @@ proc ::tk::fontchooser::Done {ok} { trace remove variable S(under) write [namespace code [list Tracer]] destroy $S(W) if {$ok} { - if {$S(-command) ne ""} { - uplevel #0 $S(-command) [list $S(result)] - } - event generate $S(-parent) <<TkFontchooserFontChanged>> + if {$S(-command) ne ""} { + uplevel #0 $S(-command) [list $S(result)] + } + event generate $S(-parent) <<TkFontchooserFontChanged>> } } @@ -343,9 +343,9 @@ proc ::tk::fontchooser::Done {ok} { proc ::tk::fontchooser::Apply {} { variable S if {$S(-command) ne ""} { - if {[catch {uplevel #0 $S(-command) [list $S(result)]} err]} { - ::bgerror $err - } + if {[catch {uplevel #0 $S(-command) [list $S(result)]} err]} { + ::bgerror $err + } } event generate $S(-parent) <<TkFontchooserFontChanged>> } @@ -361,25 +361,25 @@ proc ::tk::fontchooser::Init {{defaultFont ""}} { variable S if {$S(first) || $defaultFont ne ""} { - Canonical - if {$defaultFont eq ""} { - set defaultFont [[entry .___e] cget -font] - destroy .___e - } - array set F [font actual $defaultFont] - set S(font) $F(-family) - set S(style) [::msgcat::mc "Regular"] - set S(size) $F(-size) - set S(strike) $F(-overstrike) - set S(under) $F(-underline) - if {$F(-weight) eq "bold" && $F(-slant) eq "italic"} { - set S(style) [::msgcat::mc "Bold Italic"] - } elseif {$F(-weight) eq "bold"} { - set S(style) [::msgcat::mc "Bold"] - } elseif {$F(-slant) eq "italic"} { - set S(style) [::msgcat::mc "Italic"] - } - set S(first) 0 + Canonical + if {$defaultFont eq ""} { + set defaultFont [[entry .___e] cget -font] + destroy .___e + } + array set F [font actual $defaultFont] + set S(font) $F(-family) + set S(style) [::msgcat::mc "Regular"] + set S(size) $F(-size) + set S(strike) $F(-overstrike) + set S(under) $F(-underline) + if {$F(-weight) eq "bold" && $F(-slant) eq "italic"} { + set S(style) [::msgcat::mc "Bold Italic"] + } elseif {$F(-weight) eq "bold"} { + set S(style) [::msgcat::mc "Bold"] + } elseif {$F(-slant) eq "italic"} { + set S(style) [::msgcat::mc "Italic"] + } + set S(first) 0 } } @@ -393,11 +393,11 @@ proc ::tk::fontchooser::Init {{defaultFont ""}} { proc ::tk::fontchooser::Click {who} { variable S if {$who eq "font"} { - set S(font) [$S(W).lfonts get [$S(W).lfonts curselection]] + set S(font) [$S(W).lfonts get [$S(W).lfonts curselection]] } elseif {$who eq "style"} { - set S(style) [$S(W).lstyles get [$S(W).lstyles curselection]] + set S(style) [$S(W).lstyles get [$S(W).lstyles curselection]] } elseif {$who eq "size"} { - set S(size) [$S(W).lsizes get [$S(W).lsizes curselection]] + set S(size) [$S(W).lsizes get [$S(W).lsizes curselection]] } } @@ -412,38 +412,38 @@ proc ::tk::fontchooser::Tracer {var1 var2 op} { variable S # We don't need to process strike and under if {$var2 ni [list strike under]} { - # Make selection in listbox - set value [string tolower $S($var2)] - $S(W).l${var2}s selection clear 0 end - set n [lsearch -exact $S(${var2}s,lcase) $value] - $S(W).l${var2}s selection set $n - if {$n >= 0} { - set S($var2) [lindex $S(${var2}s) $n] - $S(W).e$var2 icursor end - $S(W).e$var2 selection clear - if {[set i [lsearch $S(bad) $var2]] >= 0} { - set S(bad) [lreplace $S(bad) $i $i] - } - } else { - # No match, try prefix - set n [lsearch -glob $S(${var2}s,lcase) "$value*"] - if {$var2 ne "size" || !([regexp -- {^(-[0-9]+|[0-9]+)$} $value] && $value >= -4096 && $value <= 4096)} { - if {[lsearch $S(bad) $var2] < 0} { - lappend S(bad) $var2 - } - } else { - if {[set i [lsearch $S(bad) $var2]] >= 0} { - set S(bad) [lreplace $S(bad) $i $i] - } - } - } - $S(W).l${var2}s see $n + # Make selection in listbox + set value [string tolower $S($var2)] + $S(W).l${var2}s selection clear 0 end + set n [lsearch -exact $S(${var2}s,lcase) $value] + $S(W).l${var2}s selection set $n + if {$n >= 0} { + set S($var2) [lindex $S(${var2}s) $n] + $S(W).e$var2 icursor end + $S(W).e$var2 selection clear + if {[set i [lsearch $S(bad) $var2]] >= 0} { + set S(bad) [lreplace $S(bad) $i $i] + } + } else { + # No match, try prefix + set n [lsearch -glob $S(${var2}s,lcase) "$value*"] + if {$var2 ne "size" || !([regexp -- {^(-[0-9]+|[0-9]+)$} $value] && $value >= -4096 && $value <= 4096)} { + if {[lsearch $S(bad) $var2] < 0} { + lappend S(bad) $var2 + } + } else { + if {[set i [lsearch $S(bad) $var2]] >= 0} { + set S(bad) [lreplace $S(bad) $i $i] + } + } + } + $S(W).l${var2}s see $n } if {[llength $S(bad)] == 0} { - set S(nstate) normal - Update + set S(nstate) normal + Update } else { - set S(nstate) disabled + set S(nstate) disabled } $S(W).ok configure -state $S(nstate) $S(W).apply configure -state $S(nstate) @@ -458,19 +458,19 @@ proc ::tk::fontchooser::Update {} { set S(result) [list $S(font) $S(size)] if {$S(style) eq [::msgcat::mc "Bold"]} { - lappend S(result) bold + lappend S(result) bold } if {$S(style) eq [::msgcat::mc "Italic"]} { - lappend S(result) italic + lappend S(result) italic } if {$S(style) eq [::msgcat::mc "Bold Italic"]} { - lappend S(result) bold italic + lappend S(result) bold italic } if {$S(strike)} { - lappend S(result) overstrike + lappend S(result) overstrike } if {$S(under)} { - lappend S(result) underline + lappend S(result) underline } $S(sample) configure -font $S(result) @@ -484,7 +484,7 @@ proc ::tk::fontchooser::Update {} { proc ::tk::fontchooser::Visibility {w visible} { variable S if {$w eq $S(W)} { - event generate $S(-parent) <<TkFontchooserVisibility>> + event generate $S(-parent) <<TkFontchooserVisibility>> } } @@ -496,17 +496,17 @@ proc ::tk::fontchooser::Visibility {w visible} { proc ::tk::fontchooser::ttk_slistbox {w args} { set f [ttk::frame $w -style FontchooserFrame -padding 1.5p] if {[catch { - listbox $f.list -relief flat -highlightthickness 0 -borderwidth 0 {*}$args - ttk::scrollbar $f.vs -command [list $f.list yview] - $f.list configure -yscrollcommand [list $f.vs set] - grid $f.list $f.vs -sticky news - grid rowconfigure $f 0 -weight 1 - grid columnconfigure $f 0 -weight 1 - interp hide {} $w - interp alias {} $w {} $f.list + listbox $f.list -relief flat -highlightthickness 0 -borderwidth 0 {*}$args + ttk::scrollbar $f.vs -command [list $f.list yview] + $f.list configure -yscrollcommand [list $f.vs set] + grid $f.list $f.vs -sticky news + grid rowconfigure $f 0 -weight 1 + grid columnconfigure $f 0 -weight 1 + interp hide {} $w + interp alias {} $w {} $f.list } err opt]} { - destroy $f - return -options $opt $err + destroy $f + return -options $opt $err } return $w } |