TIP #324 IMPLEMENTATION

6 files changed, 501 insertions, 6 deletions

diff --git a/library/console.tcl b/library/console.tcl
index cc38ca5..2fddfe3 100644
--- a/library/console.tcl
+++ b/library/console.tcl
@@ -4,11 +4,11 @@
 # can be used by non-unix systems that do not have built-in support
 # for shells.
 #
-# RCS: @(#) $Id: console.tcl,v 1.38 2008/05/13 13:25:18 patthoyts Exp $
+# RCS: @(#) $Id: console.tcl,v 1.39 2008/12/10 05:02:51 das Exp $
 #
 # Copyright (c) 1995-1997 Sun Microsystems, Inc.
 # Copyright (c) 1998-2000 Ajuba Solutions.
-# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
+# Copyright (c) 2007-2008 Daniel A. Steffen <das@users.sourceforge.net>
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -22,11 +22,10 @@ namespace eval ::tk::console {
     variable magicKeys   1   ; # enable brace matching and proc/var recognition
     variable maxLines    600 ; # maximum # of lines buffered in console
     variable showMatches 1   ; # show multiple expand matches
-
+    variable useFontchooser [llength [info command ::tk::fontchooser]]
     variable inPlugin [info exists embed_args]
     variable defaultPrompt   ; # default prompt if tcl_prompt1 isn't used
 
-
     if {$inPlugin} {
 	set defaultPrompt {subst {[history nextid] % }}
     } else {
@@ -98,6 +97,24 @@ proc ::tk::ConsoleInit {} {
     }
 
     AmpMenuArgs .menubar.edit add separator
+    if {$::tk::console::useFontchooser} {
+        if {[tk windowingsystem] eq "aqua"} {
+            .menubar.edit add command -label tk_choose_font_marker
+            set index [.menubar.edit index tk_choose_font_marker]
+            .menubar.edit entryconfigure $index \
+                -label [mc "Show Fonts"]\
+                -accelerator "$mod-T"\
+                -command [list ::tk::console::FontchooserToggle]
+            bind Console <<TkFontchooserVisibility>> \
+                [list ::tk::console::FontchooserVisibility $index]
+	    ::tk::console::FontchooserVisibility $index
+        } else {
+            AmpMenuArgs .menubar.edit add command -label [mc "&Font..."] \
+                -command [list ::tk::console::FontchooserToggle]
+        }
+	bind Console <FocusIn>  [list ::tk::console::FontchooserFocus %W 1]
+	bind Console <FocusOut> [list ::tk::console::FontchooserFocus %W 0]
+    }
     AmpMenuArgs .menubar.edit add command -label [mc "&Increase Font Size"] \
         -accel "$mod++" -command {event generate .console <<Console_FontSizeIncr>>}
     AmpMenuArgs .menubar.edit add command -label [mc "&Decrease Font Size"] \
@@ -396,6 +413,9 @@ proc ::tk::ConsoleBind {w} {
 	    event add $ev $key
 	    bind Console $key {}
 	}
+	if {$::tk::console::useFontchooser} {
+	    bind Console <Command-Key-t> [list ::tk::console::FontchooserToggle]
+	}
     }
     bind Console <<Console_Expand>> {
 	if {[%W compare insert > promptEnd]} {
@@ -557,6 +577,9 @@ proc ::tk::ConsoleBind {w} {
         if {$size < 0} {set sign -1} else {set sign 1}
         set size [expr {(abs($size) + 1) * $sign}]
         font configure TkConsoleFont -size $size
+	if {$::tk::console::useFontchooser} {
+	    tk fontchooser configure -font TkConsoleFont
+	}
     }
     bind Console <<Console_FontSizeDecr>> {
         set size [font configure TkConsoleFont -size]
@@ -564,6 +587,9 @@ proc ::tk::ConsoleBind {w} {
         if {$size < 0} {set sign -1} else {set sign 1}
         set size [expr {(abs($size) - 1) * $sign}]
         font configure TkConsoleFont -size $size
+	if {$::tk::console::useFontchooser} {
+	    tk fontchooser configure -font TkConsoleFont
+	}
     }
 
     ##
@@ -669,6 +695,35 @@ Tcl $::tcl_patchLevel
 Tk $::tk_patchLevel"
 }
 
+# ::tk::console::Fontchooser* --
+# 	Let the user select the console font (TIP 324).
+
+proc ::tk::console::FontchooserToggle {} {
+    if {[tk fontchooser configure -visible]} {
+	tk fontchooser hide
+    } else {
+	tk fontchooser show
+    }
+}
+proc ::tk::console::FontchooserVisibility {index} {
+    if {[tk fontchooser configure -visible]} {
+	.menubar.edit entryconfigure $index -label [msgcat::mc "Hide Fonts"]
+    } else {
+	.menubar.edit entryconfigure $index -label [msgcat::mc "Show Fonts"]
+    }
+}
+proc ::tk::console::FontchooserFocus {w isFocusIn} {
+    if {$isFocusIn} {
+	tk fontchooser configure -parent $w -font TkConsoleFont \
+		-command [namespace code [list FontchooserApply]]
+    } else {
+	tk fontchooser configure -parent $w -font {} -command {}
+    }
+}
+proc ::tk::console::FontchooserApply {font args} {
+    catch {font configure TkConsoleFont {*}[font actual $font]}
+}
+
 # ::tk::console::TagProc --
 #
 # Tags a procedure in the console if it's recognized
diff --git a/library/demos/text.tcl b/library/demos/text.tcl
index 6f25273..5b8341d 100644
--- a/library/demos/text.tcl
+++ b/library/demos/text.tcl
@@ -3,7 +3,7 @@
 # This demonstration script creates a text widget that describes
 # the basic editing functions.
 #
-# RCS: @(#) $Id: text.tcl,v 1.8 2007/12/13 15:27:07 dgp Exp $
+# RCS: @(#) $Id: text.tcl,v 1.9 2008/12/10 05:02:51 das Exp $
 
 if {![info exists widgetDemo]} {
     error "This script should be run from the \"widget\" demo."
@@ -19,7 +19,8 @@ wm iconname $w "text"
 positionWindow $w
 
 ## See Code / Dismiss buttons
-set btns [addSeeDismiss $w.buttons $w]
+set btns [addSeeDismiss $w.buttons $w {} \
+	{ttk::button $w.buttons.fontchooser -command fontchooserToggle}]
 pack $btns -side bottom -fill x
 
 text $w.text -yscrollcommand [list $w.scroll set] -setgrid 1 \
@@ -27,6 +28,30 @@ text $w.text -yscrollcommand [list $w.scroll set] -setgrid 1 \
 scrollbar $w.scroll -command [list $w.text yview]
 pack $w.scroll -side right -fill y
 pack $w.text -expand yes -fill both
+
+# TIP 324 Demo: [tk fontchooser]
+proc fontchooserToggle {} {
+    tk fontchooser [expr {[tk fontchooser configure -visible] ?
+            "hide" : "show"}]
+}
+proc fontchooserVisibility {w} {
+    $w configure -text [expr {[tk fontchooser configure -visible] ?
+            "Hide Font Dialog" : "Show Font Dialog"}]
+}
+proc fontchooserFocus {w} {
+    tk fontchooser configure -font [$w cget -font] \
+	    -command [list fontchooserFontSel $w]
+}
+proc fontchooserFontSel {w font args} {
+    $w configure -font [font actual $font]
+}
+tk fontchooser configure -parent $w
+bind $w.text <FocusIn> [list fontchooserFocus $w.text]
+fontchooserVisibility $w.buttons.fontchooser
+bind $w <<TkFontchooserVisibility>> [list \
+	fontchooserVisibility $w.buttons.fontchooser]
+focus $w.text
+
 $w.text insert 0.0 \
 {This window is a text widget.  It displays one or more lines of text
 and allows you to edit the text.  Here is a summary of the things you
diff --git a/library/fontchooser.tcl b/library/fontchooser.tcl
new file mode 100644
index 0000000..290eebf
--- /dev/null
+++ b/library/fontchooser.tcl
@@ -0,0 +1,398 @@
+# fontchooser.tcl -
+#
+#	A themeable Tk font selection dialog. See TIP #324.
+#
+# Copyright (C) 2008 Keith Vetter
+# Copyright (C) 2008 Pat Thoyts <patthoyts@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: fontchooser.tcl,v 1.1 2008/12/10 05:02:51 das Exp $
+
+namespace eval ::tk::fontchooser {
+    variable S
+
+    set S(W) .__tk__fontchooser
+    set S(fonts) [lsort -dictionary [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(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(-font) {}
+    set S(-command) {}
+
+    # 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]}
+    set S(sizes,lcase) $S(sizes)
+
+    ::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
+    }
+}
+
+proc ::tk::fontchooser::Show {} {
+    variable S
+    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] == 1 && [string equal [lindex $args 0] "-visible"]} {
+        return [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}]
+    }
+
+    tclParseConfigSpec [namespace which -variable S] $specs "" $args
+    if {$S(-parent) ne "."} {
+	winfo toplevel $S(-parent)
+    }
+    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>>
+    }
+}
+
+proc ::tk::fontchooser::Create {} {
+    variable S
+    set windowName __tk__fontchooser
+    if {$S(-parent) eq "."} {
+        set S(W) .$windowName
+    } else {
+        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)]
+        wm geometry $S(W) 430x316
+
+        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:"]
+        ttk::entry $S(W).efont -textvariable [namespace which -variable S](font)
+        ttk::entry $S(W).estyle -textvariable [namespace which -variable S](style)
+        ttk::entry $S(W).esize -textvariable [namespace which -variable S](size) \
+            -width 0 -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 6 -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]]
+
+        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 8 -pady 6
+        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
+        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 10
+        grid columnconfigure $outer {0 2 4} -weight 1
+
+        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) "Bold Italic"
+        } elseif {$F(-weight) eq "bold"} {
+            set S(style) "Bold"
+        } elseif {$F(-slant) eq "italic"} {
+            set S(style) "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 config -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 "Bold"} { lappend S(result) bold }
+    if {$S(style) eq "Italic"} { lappend S(result) italic }
+    if {$S(style) eq "Bold Italic"} { lappend S(result) bold italic}
+    if {$S(strike)} { lappend S(result) overstrike}
+    if {$S(under)} { lappend S(result) underline}
+
+    $S(sample) config -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]} {
+        destroy $f
+        return -code error $err
+    }
+    return $w
+}
diff --git a/library/msgs/de.msg b/library/msgs/de.msg
index 39daf82..aa20340 100644
--- a/library/msgs/de.msg
+++ b/library/msgs/de.msg
@@ -5,6 +5,7 @@ namespace eval ::tk {
     ::msgcat::mcset de "Application Error" "Applikationsfehler"
     ::msgcat::mcset de "&Blue" "&Blau"
     ::msgcat::mcset de "&Cancel" "&Abbruch"
+    ::msgcat::mcset de "Cancel" "Abbruch"
     ::msgcat::mcset de "Cannot change to the directory \"%1\$s\".\nPermission denied." "Kann nicht in das Verzeichnis \"%1\$s\" wechseln.\nKeine Rechte vorhanden."
     ::msgcat::mcset de "Choose Directory" "W\u00e4hle Verzeichnis"
     ::msgcat::mcset de "&Clear" "&R\u00fccksetzen"
diff --git a/library/msgs/en.msg b/library/msgs/en.msg
index b4e51bf..5ad1094 100644
--- a/library/msgs/en.msg
+++ b/library/msgs/en.msg
@@ -3,7 +3,11 @@ namespace eval ::tk {
     ::msgcat::mcset en "&About..."
     ::msgcat::mcset en "All Files"
     ::msgcat::mcset en "Application Error"
+    ::msgcat::mcset en "&Apply"
+    ::msgcat::mcset en "Bold"
+    ::msgcat::mcset en "Bold Italic"
     ::msgcat::mcset en "&Blue"
+    ::msgcat::mcset en "Cancel"
     ::msgcat::mcset en "&Cancel"
     ::msgcat::mcset en "Cannot change to the directory \"%1\$s\".\nPermission denied."
     ::msgcat::mcset en "Choose Directory"
@@ -18,6 +22,7 @@ namespace eval ::tk {
     ::msgcat::mcset en "Directory \"%1\$s\" does not exist."
     ::msgcat::mcset en "&Directory:"
     ::msgcat::mcset en "&Edit"
+    ::msgcat::mcset en "Effects"
     ::msgcat::mcset en "Error: %1\$s"
     ::msgcat::mcset en "E&xit"
     ::msgcat::mcset en "&File"
@@ -30,15 +35,20 @@ namespace eval ::tk {
     ::msgcat::mcset en "Fi&les:"
     ::msgcat::mcset en "&Filter"
     ::msgcat::mcset en "Fil&ter:"
+    ::msgcat::mcset en "Font"
+    ::msgcat::mcset en "&Font:"
+    ::msgcat::mcset en "Font st&yle:"
     ::msgcat::mcset en "&Green"
     ::msgcat::mcset en "&Help"
     ::msgcat::mcset en "Hi"
     ::msgcat::mcset en "&Hide Console"
     ::msgcat::mcset en "&Ignore"
     ::msgcat::mcset en "Invalid file name \"%1\$s\"."
+    ::msgcat::mcset en "Italic"
     ::msgcat::mcset en "Log Files"
     ::msgcat::mcset en "&No"
     ::msgcat::mcset en "&OK"
+    ::msgcat::mcset en "OK"
     ::msgcat::mcset en "Ok"
     ::msgcat::mcset en "Open"
     ::msgcat::mcset en "&Open"
@@ -46,21 +56,26 @@ namespace eval ::tk {
     ::msgcat::mcset en "P&aste"
     ::msgcat::mcset en "&Quit"
     ::msgcat::mcset en "&Red"
+    ::msgcat::mcset en "Regular"
     ::msgcat::mcset en "Replace existing file?"
     ::msgcat::mcset en "&Retry"
+    ::msgcat::mcset en "Sample"
     ::msgcat::mcset en "&Save"
     ::msgcat::mcset en "Save As"
     ::msgcat::mcset en "Save To Log"
     ::msgcat::mcset en "Select Log File"
     ::msgcat::mcset en "Select a file to source"
     ::msgcat::mcset en "&Selection:"
+    ::msgcat::mcset en "&Size:"
     ::msgcat::mcset en "Show &Hidden Directories"
     ::msgcat::mcset en "Show &Hidden Files and Directories"
     ::msgcat::mcset en "Skip Messages"
     ::msgcat::mcset en "&Source..."
+    ::msgcat::mcset en "Stri&keout"
     ::msgcat::mcset en "Tcl Scripts"
     ::msgcat::mcset en "Tcl for Windows"
     ::msgcat::mcset en "Text Files"
+    ::msgcat::mcset en "&Underline"
     ::msgcat::mcset en "&Yes"
     ::msgcat::mcset en "abort"
     ::msgcat::mcset en "blue"
diff --git a/library/tclIndex b/library/tclIndex
index e7f5b81..df4c046 100644
--- a/library/tclIndex
+++ b/library/tclIndex
@@ -276,3 +276,4 @@ set auto_index(::tk::ListBoxKeyAccel_Reset) [list source [file join $dir xmfbox.
 set auto_index(tk_getFileType) [list source [file join $dir xmfbox.tcl]]
 set auto_index(::tk::unsupported::ExposePrivateCommand) [list source [file join $dir unsupported.tcl]]
 set auto_index(::tk::unsupported::ExposePrivateVariable) [list source [file join $dir unsupported.tcl]]
+set auto_index(::tk::fontchooser) [list source [file join $dir fontchooser.tcl]]