fontview as eTcl plugin

Richard Suchenwirth 2006-02-07 - As if there weren't already enough font viewers around, I had to roll my own for Sepp. I first tried the one from BWidget, but the geometry was misfit for PocketPC (and I couldn't hot-patch it, since the dialog is modal), and the sample text was fixed in a label, while I wanted it to be editable, as text widget, and to have the selected font/size/style combo in the clipboard, so I could paste it into the editor.

So, here goes (testable standalone on desktop, too):

 proc fontview {} {
    global g
    if ![winfo exists .fv] {
        toplevel .fv
        wm title .fv "Select Font"
        listbox .fv.fam  -yscrollcommand ".fv.1 set" \
                -width 22 -exportselection 0
        eval .fv.fam insert end [lsort -dic [font families]]
        scrollbar .fv.1 -command ".fv.fam yview"
        listbox .fv.s -yscrollcommand ".fv.2 set" -width 4 -exportselection 0
        .fv.s insert end 6 7 8 9 10 11 12 13 14 15 16 17 18 19 \
                20 22 24 28 32 36 40
        scrollbar .fv.2 -command ".fv.s yview"
        frame .fv.f
        checkbutton .fv.f.b -text Bold   -variable g(Bold)
        checkbutton .fv.f.i -text Italic -variable g(Italic)
        label .fv.f.dummy -text " "
        button .fv.f.ok -text Copy -command {
            clipboard clear; clipboard append [list [.fv.t cget -font]]
        }
        eval pack [winfo children .fv.f] -anchor w -fill x
        grid .fv.fam .fv.1 .fv.s .fv.2 .fv.f -sticky ns -padx 2
        grid [text .fv.t -width 1 -height 2 -wrap word] - - - - -sticky news
        grid columnconfig .fv 0 -weight 1
        grid rowconfig .fv 1 -weight 1
        .fv.t tag config center -justify center
        .fv.t insert end "Sample text" center
        wm geometry .fv 240x268
        foreach w {.fv.fam .fv.s .fv.f.b .fv.f.i} {
            bind $w <ButtonRelease-1> {after 1 {fontview'update .fv}}
        }
    }
    wm deiconify .fv
 }
 proc fontview'update w {
    set style ""
    if $::g(Bold)   {set     style bold}
    if $::g(Italic) {lappend style italic}
    set size [$w.s get anchor]
    if {$size eq ""} return
    set font [list [$w.fam get anchor] $size $style]
    $w.t config -font $font
 } 

 if {[file tail [info script]] eq [file tail $argv0]} {
    fontview
    bind all <Escape> {exec wish $argv0 &; exit}
 }

Category Development