Updated 2013-10-16 06:32:23 by pooryorick

Jos Decoster <decoster@retarget.com> wrote in comp.lang.tcl:

When not using canvas widgets, I sometimes use the following to change the fonts of a running application:
 # Put your favourite fonts here
 set font(Button)      {Helvetica -12 bold}
 set font(Checkbutton) {Helvetica -12 bold}
 set font(Radiobutton) {Helvetica -12 bold}
 set font(Label)       {Helvetica -12 bold}
 set font(Entry)       {Helvetica -12}
 set font(Listbox)     {Helvetica -12 bold}
 set font(Menuentry)   {Helvetica -12 bold}
 set font(Menu)        {Helvetica -12 bold}
 set font(Menubutton)  {Helvetica -12 bold}
 set font(Message)     {Helvetica -12 bold}
 set font(Scale)       {Helvetica -12 bold}
 set font(Text)        {Courier   -12}

 proc refont_tree { path } {
    global font

    foreach child [winfo children $path] {
        set childtype [winfo class $child]
        if { [info exists font($childtype)] } {
            if {[catch {$child configure -font $font($childtype)} msg] } {
                puts stderr "$child ($childtype) ERROR: $msg"
            }
        }
        refont_tree $child
    }
 }

 refont_tree .

MGS - Wouldn't it be better to create a named font for each widget class, and then use the options database to 'apply' each font to that class? E.g.
 foreach class {
   Button Checkbutton Entry Label Listbox
   Menu Menubutton Message Radiobutton Scale
 } {
   font create $class -family Helvetica -size 12
   option add *$class.font $class widgetDefault
 }
 font create Text -family courier -size 12
 option add *Text.font Text widgetDefault

See also: font scaling and named fonts

LV - Is there a way to introspectively determine the list of classes, so as to be able to handle additional extensions, etc.?

MGS - Yes, that certainly would be useful. CL says, "Me, too."

RS: A plausible implementation could define a tk classes subcommand. Not all widgets take a -font option (at least frame, toplevel, panedwindow), but by using the option database this can't hurt - redundant options cause no error.