tk fontchooser

Difference between version 5 and 6 - Previous - Next
This [Tk] command was added due to [TIP]#324 [http://tip.tcl.tk/324]
----
[ZB] What do you think about moving "OK" and "Cancel" buttons down, and place them horizontally, under "Effect"/"Sample" frames? Currently there's a whole lot of empty space on the right, due to buttons position.

[DKF]: The current dialog has rather a lot more wrong with it than that. (For example, it's localization is utterly botched, its usability is substandard and its key bindings are incomplete.) I think the best phrase to use is “not yet fixed”.

[HE] 2020-07-12: Some remarks from my side.

First my opinion: I don't like that the dialog doesn't work as the other build in dialogs of Tk.
I like it more to call a dialog and get a return value back as it is done by tk_getOpenFile or tk_chooseDirectory for example.

Now what I found out about if it works on different platforms.

If I use tk fontchooser on Windows 10, it use tthe OS internal font dialog. This works mainly as expected. This doesn't mean, that I have checked everything. The main caveat is that OS dialogs does not use the locale used by the program. They use the locale configured in the user profile. But, this is a problem which other dialogs have, too.

I have no OS X systems so I can't check the behavior on such a system.

On Linux and related OS a dialog implemented in Tcl is used. This dialog could be also used in the other OS by calling ::tk::fontchooser configure|show|hide.

The problem with that is, that the implementation looks like it is stopped in between, as [DKF] mentioned before. There is a patch from 2008 which tries to fix it (https://core.tcl-lang.org/tk/tktview?name=2442314fff). This patch doesn't work any longer. But, the changes would not have been fix it completely.

Non documented/not directly clear behaviour of the Tcl only version:
   * 'tk fontchooser hide' will withdraw the dialog. A call of 'tk fontchooser show' will then show it again. Locale are unchanged.
   * Button 'Ok' and 'Cancel' will destroy the dialog.
   * - Button 'Ok' and 'Apply' will provide the current selected font to the callback procedure.

The dialog exists in lib/tk8.6/fontchooser.tcl of the installation. 
In the sources the file is in tk8.6.10/generic/.

What doesn't work: 

Described by the supplier of the patch:
   * The Tcl implementation of fontchooser does not use the message catalog to display font styles.
   * Furthermore the label for the Font size uses the same width as the listbox that contains the numbers of the font sizes. This may not be wide enough for some languages like German for example.

Found by me after applying the patch manually:
   * The locale of the style is set when fontchooser.tcl is sourced. Therefore, a locale change afterwards will not change the displayed style. All other strings use a changed locale when the dialog is new created.
   * The default value of style is not translated into the used locale. If the selected locale use different strings for the styles, you can't use the 'Ok' button but the 'Apply' button.
   * The provided font does not contain the style attributes in case of a locale like de. Reason is that the value is not translated back to the way Tk use it.

I filled a ticket (https://core.tcl-lang.org/tk/tktview?name=1f46cac080) for that.

The following is the contents of the fontchooser.tcl in Tk 8.6.10 updated to fix all the listed issues. It doesn't cleanup or improve the code. Simply replace the contents of the installed fontchooser.tcl with the below code (For sure it is a good idea to save the original file before):

======
# fontchooser.tcl -
#
#        A themeable Tk font selection dialog. See TIP #324.
#
# Copyright (C) 2008 Keith Vetter
# Copyright (C) 2008 Pat Thoyts <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

namespace eval ::tk::fontchooser {
    variable S
        
    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"] \
    ]

    set S(sizes) {8 9 10 11 12 14 16 18 20 22 24 26 28 36 48 72}
    set S(sizes,lcase) $S(sizes)
    set S(strike) 0
    set S(under) 0
    set S(first) 1
    set S(sampletext) [::msgcat::mc "AaBbYyZz01"]
    set S(-parent) .
    set S(-title) [::msgcat::mc "Font"]
    set S(-command) ""
    set S(-font) TkDefaultFont
        
    set windowName __tk__fontchooser
    if {$S(-parent) eq "."} {
        set S(W) .$windowName
    } else {
        set S(W) $S(-parent).$windowName
    }
}

proc ::tk::fontchooser::Canonical {} {
    variable S

        # 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]}
    set S(styles,lcase) {}
    foreach style $S(styles) {lappend S(styles,lcase) [string tolower $style]}
}

proc ::tk::fontchooser::Setup {} {
        Canonical

    ::ttk::style layout FontchooserFrame {
        Entry.field -sticky news -border true -children {
            FontchooserFrame.padding -sticky news
        }
    }
    bind [winfo class .] <<ThemeChanged>> \
        [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
    }
}
::tk::fontchooser::Setup

proc ::tk::fontchooser::Show {} {
    variable S

    set S(styles) [list \
         [::msgcat::mc "Regular"] \
         [::msgcat::mc "Italic"] \
         [::msgcat::mc "Bold"] \
         [::msgcat::mc "Bold Italic"] \
    ]
    set S(sampletext) [::msgcat::mc "AaBbYyZz01"]
    set S(-title) [::msgcat::mc "Font"]
    set S(fonts) [lsort -dictionary -unique [font families]]
        Canonical
        
    if {![winfo exists $S(W)]} {
        Create
        wm transient $S(W) [winfo toplevel $S(-parent)]
        tk::PlaceWindow $S(W) widget $S(-parent)
    }
    wm deiconify $S(W)
}

proc ::tk::fontchooser::Hide {} {
    variable S
    wm withdraw $S(W)
}

proc ::tk::fontchooser::Configure {args} {
    variable S

    set specs {
        {-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
    }
    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 cache [dict create -parent $S(-parent) -title $S(-title) \
                   -font $S(-font) -command $S(-command)]
    set r [tclParseConfigSpec [namespace which -variable S] $specs "" $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
    }
    if {[string trim $S(-title)] eq ""} {
        set S(-title) [::msgcat::mc "Font"]
    }
    if {[winfo exists $S(W)] && [lsearch $args -font] != -1} {
        Init $S(-font)
        event generate $S(-parent) <<TkFontchooserFontChanged>>
    }
    return $r
}

proc ::tk::fontchooser::Create {} {
    variable S

    # 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 scaling [tk scaling]
        set sizeWidth [expr {int([string length [::msgcat::mc "&Size:"]] * $scaling)}]

        set outer [::ttk::frame $S(W).outer -padding {10 10}]
        ::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:"] -width $sizeWidth
        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 {string is double %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) 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 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 6 -pady 4
        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 2}
        grid $S(W).cancel -in $bbox -sticky new -pady 2
        if {$S(-command) ne ""} {
            grid $S(W).apply -in $bbox -sticky new -pady 2
        }
        grid columnconfigure $bbox 0 -weight 1

        grid $WE.strike -sticky w -padx 10
        grid $WE.under -sticky w -padx 10 -pady {0 30}
        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 {15 30}
        grid configure $bbox -sticky n
        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]]
    } else {
        Init $S(-font)
    }

    return
}

# ::tk::fontchooser::Done --
#
#       Handles teardown of the dialog, calling -command if needed
#
# Arguments:
#       ok              true if user pressed OK
#
proc ::tk::::fontchooser::Done {ok} {
    variable S

    if {! $ok} {
        set S(result) ""
    }
    trace vdelete S(size) w [namespace code [list Tracer]]
    trace vdelete S(style) w [namespace code [list Tracer]]
    trace vdelete S(font) w [namespace code [list Tracer]]
    destroy $S(W)
    if {$ok && $S(-command) ne ""} {
        uplevel #0 $S(-command) [list $S(result)]
    }
}

# ::tk::fontchooser::Apply --
#
#        Call the -command procedure appending the current font
#        Errors are reported via the background error mechanism
#
proc ::tk::fontchooser::Apply {} {
    variable S
    if {$S(-command) ne ""} {
        if {[catch {uplevel #0 $S(-command) [list $S(result)]} err]} {
            ::bgerror $err
        }
    }
    event generate $S(-parent) <<TkFontchooserFontChanged>>
}

# ::tk::fontchooser::Init --
#
#       Initializes dialog to a default font
#
# Arguments:
#       defaultFont     font to use as the default
#
proc ::tk::fontchooser::Init {{defaultFont ""}} {
    variable S

    if {$S(first) || $defaultFont ne ""} {
        if {$defaultFont eq ""} {
            set defaultFont [[entry .___e] cget -font]
            destroy .___e
        }
        array set F [font actual $defaultFont]
        set S(font) $F(-family)
        set S(size) $F(-size)
        set S(strike) $F(-overstrike)
        set S(under) $F(-underline)
        set S(style) "Regular"
        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
    }

    Tracer a b c
    Update
}

# ::tk::fontchooser::Click --
#
#       Handles all button clicks, updating the appropriate widgets
#
# Arguments:
#       who             which widget got pressed
#
proc ::tk::fontchooser::Click {who} {
    variable S

    if {$who eq "font"} {
        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]]
    } elseif {$who eq "size"} {
        set S(size) [$S(W).lsizes get [$S(W).lsizes curselection]]
    }
    Update
}

# ::tk::fontchooser::Tracer --
#
#       Handles traces on key variables, updating the appropriate widgets
#
# Arguments:
#       standard trace arguments (not used)
#
proc ::tk::fontchooser::Tracer {var1 var2 op} {
    variable S

    set bad 0
    set nstate normal
    # Make selection in each listbox
    foreach var {font style size} {
        set value [string tolower $S($var)]
        $S(W).l${var}s selection clear 0 end
        set n [lsearch -exact $S(${var}s,lcase) $value]
        $S(W).l${var}s selection set $n
        if {$n != -1} {
            set S($var) [lindex $S(${var}s) $n]
            $S(W).e$var icursor end
            $S(W).e$var selection clear
        } else {                                ;# No match, try prefix
            # Size is weird: valid numbers are legal but don't display
            # unless in the font size list
            set n [lsearch -glob $S(${var}s,lcase) "$value*"]
            set bad 1
            if {$var ne "size" || ! [string is double -strict $value]} {
                set nstate disabled
            }
        }
        $S(W).l${var}s see $n
    }
    if {!$bad} { Update }
    $S(W).ok configure -state $nstate
        $S(W).apply configure -state $nstate
}

# ::tk::fontchooser::Update --
#
#       Shows a sample of the currently selected font
#
proc ::tk::fontchooser::Update {} {
    variable S

    set S(result) [list $S(font) $S(size)]
    if {$S(style) eq [::msgcat::mc "Bold"]} {lappend S(result) bold}
    if {$S(style) eq [::msgcat::mc "Italic"]} {lappend S(result) italic}
    if {$S(style) eq [::msgcat::mc "Bold Italic"]} {lappend S(result) bold italic}
    if {$S(strike)} {lappend S(result) overstrike}
    if {$S(under)} {lappend S(result) underline}
    $S(sample) configure -font $S(result)
}

# ::tk::fontchooser::Visibility --
#
#        Notify the parent when the dialog visibility changes
#
proc ::tk::fontchooser::Visibility {w visible} {
    variable S
    if {$w eq $S(W)} {
        event generate $S(-parent) <<TkFontchooserVisibility>>
    }
}

# ::tk::fontchooser::ttk_listbox --
#
#        Create a properly themed scrolled listbox.
#        This is exactly right on XP but may need adjusting on other platforms.
#
proc ::tk::fontchooser::ttk_slistbox {w args} {
    set f [ttk::frame $w -style FontchooserFrame -padding 2]
    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
    } err opt]} {
        destroy $f
        return -options $opt $err
    }
    return $w
}
======
[HE] 2021-09-24: tk fontchooser of Tcl/Tk 8.6.11 has still issues. I filled a ticket (https://core.tcl-lang.org/tk/tktview/f75190db19) for that. A patch and a replacement for fontchooser.tcl are attached to the ticket.
Now to the description of the tickets:
1. The dialog shows a lot of duplicated font families.
Reason is that the code in fontchooser.tcl uses
"set S(fonts) [lsort -dictionary [font families]]"
two times instead of
"set S(fonts) [lsort -dictionary -unique [font families]]"
2. Locale change doesn't change all text in dialog correctly. Font style in the listbox stays with the old locale. In case of not en, this leads to wrong results.
======
# I'm using de normally. To have the default behaviour I set it first to en
::msgcat::mclocale en
# Configure command
proc font_cb {args} {
puts "args: $args"
return
}
tk fontchooser configure -command font_cb
tk fontchooser show
# Press Apply button provided on my computer "{{DejaVu Sans} 9}"
# Change font style to italic and press Apply provides "{{DejaVu Sans} 9 italic}"
# Change font size to 14 and press Apply provides "{{DejaVu Sans} 14 italic}"
# Select Strikeout and press Apply provides "{{DejaVu Sans} 14 italic overstrike}"
# Select Underline and press Apply provides "{{DejaVu Sans} 14 italic overstrike underline}"
# Change Font and press Apply provides "{Georgia 14 italic overstrike underline}"
# Now we change locale to de
::msgcat::mclocale de
# Dialog has still the old language and the output is the same
# Press Cancel to destroy the dialog
tk fontchooser show
# Now the dialog is in German beside font style in listbox which is still in english.
# The selected style is displayed in the entry in German.
# We select the same font as with our last try: "{Georgia 14 italic overstrike underline}".
# Press Apply (now Anwenden) provides "{Georgia 14 overstrike underline}".
# The font style selection is ignored. That means it is 'regular'.
======
Reason is that "set S(styles) ..." is defined during namespace definition and not in ::tk::fontchooser::Show. Doing this in show would change the locale at least after the dialog is shown after using Ok or Cancel button.
3. The title of the dialog is not changing in case the locale is changed.
Reason is that "set S(-title) [::msgcat::mc "Font"]" is defined during namespace definition and not in ::tk::fontchooser::Show.
Doing this in show would change the locale at least after the dialog is shown after using Ok or Cancel button.
This still has an issue. "Font" is english for Font. In German "Schriftart" would be expected. Missing is an mechanism which detects that -title is not defined.
That means we should not set -title with a default string. Instead we should keep it empty and test if empty if we set the title of the window. This could be done regularly during executing ::tk::fontchooser::Show.
4. The sample text is also defined inside the namespace definition. This should also moved to ::tk::fontchooser::Show.
5. Confguration of -title does not take effect directly. The dialog has to be destroyed by using button Ok or Cancel.
Expected behaviour would be that title is changed directly when tk fontchooser configure -title newValue is done.
Needed changes: Add the following to ::tk::fontchooser::Configure before the last return:
======
if {[string trim $S(-title)] eq {}} {
wm title $S(W) [::msgcat::mc Font]
} else {
wm title $S(W) $S(-title)
}
======
6. If font entry or size entry is cleared Ok button becomes disabled. The Apply button is still usable (state = normal).
Needed changes: Add the following to ::tk::fontchooser::Tracer as the last line:
$S(W).apply configure -state $nstate
7. A wrong behaviour of the dialog: The dialog shows only the buttons Ok and Cancel if -command is not configured (is empty).
In case configured we have three buttons: Ok, Cancel and Apply.
That makes no sense, button Ok and Cancel do the same in case no command (callback) is configured. That means Cancel would be enough.
On the other side button Apply raise event <<TkFontchooserFontChanged>> which is needed to use the dialog with empty -command.
In case the command is configured later, we will still have Ok and Cancel only. We still miss the function of Apply.
If we start with configured command all three buttons are shown. If the command is then set to {} we have again not correct working button.
In both cases the dialog should be able to show that state. That could be done by display allways all three buttons and activate/deactivate them (state normal and disabled) depending on the situation.
======
tk fontchooser show ;# Only Ok and Cancel
# Configure command
proc font_cb {args} {
puts "args: $args"
return
}
tk fontchooser configure -command font_cb
tk fontchooser hide
tk fontchooser show ;# Still only Ok and Cancel
# Press Ok then call
tk fontchooser show ;# Ok, Cancel and Apply
tk fontchooser configure -command {}
tk fontchooser hide
tk fontchooser show ;# Still Ok, Cancel and Apply
# Press Ok then call
tk fontchooser show ;# Ok and Cancel only
======
Changes needed:
In procedure ::tk::fontchooser::Tracer move nstate into array S to be able to access the value in ::tk::fontchooser::Configure.
Replace in ::tk::fontchooser::Create
======
if {$S(-command) ne ""} {
grid $S(W).apply -in $bbox -sticky new -pady 2
}
======
with
======
grid $S(W).apply -in $bbox -sticky new -pady 2
======
Also we need to change ::tk::fontchooser::Configure to handle the state of the buttons Ok and Apply.
To check the behaviour of <<TkFontchooserFontChanged>> use
======
bind . <<TkFontchooserFontChanged>> {puts "Font Changed"}
======
<<categories>> Command | Widget