package require Tk
 
 canvas .c -bd 0 -height 0 -highlightthickness 0 ;# Just for resizing by pixels
 scrollbar .sb -orient vertical -command {.t yview}
 text .t -wrap none -yscrollcommand {.sb set} -width 0
 
 pack .sb -fill y -side right
 pack .c  -fill both -expand 1 -side top
 pack .t  -fill both -expand 1 -side left
 bind all <Key-F2> {console show}
 
 catch {eval font delete [font names]}
 set default [lindex [.t config -font] 3]
 .t tag configure default -font $default
 set sample "AaBbCcDdEeFfGgHhIi 1234567890 .,+-:*?!"
 
 set left  0
 set width 0
 
 foreach font [lsort -dictionary [font families]] {
    set len [font measure $default $font]       ;# Size of font name
    if {$len > $left} {set left $len}
    
    set f [font create -family $font]
    set len [font measure $f $sample]
    if {$len > $width} {set width $len}
    if {[font metrics $f -fixed]} {
        .t insert end "*" default
    }
     
    .t tag configure tag_$f -font $f
    .t insert end "$font\t" default "$sample\n" tag_$f
 }
 set left  [expr {$left + 5}]
 set width [expr {$width + $left + 10}]
 .t config -tabs [list [expr {($left + $width) / 2}] center]
 .c config -width $width