Another font chooser dialog - based on tablelist

JOB 18-03-06, here is another kind of font chooser dialog with a "live preview" of the available (build in) font styles. The dialog is based on tablelist, hence the search functionality is implemented with the help of the "configure -colorizecommand" sub-command.

From a functional point of view, the dialog is pretty complete. There is a search and filter option available, which allows to shrink down a long list of entries quite easily. In addition, there is one more column to indicate fixed fonts.

I always wanted to bring such a dialog to live and since then I do not want to miss it either.

WikiDBImage fontselectiondialog.png

Here is the code:

  • fontseldialog.tcl
# ------------------------------------------------------------------------
# fontseldialog.tcl ---
# ------------------------------------------------------------------------
# (c) 2017, Johann Oberdorfer - Engineering Support | CAD | Software
#     johann.oberdorfer [at] gmail.com
#     www.johann-oberdorfer.eu
# ------------------------------------------------------------------------
# This source file is distributed under the BSD license.
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#   See the BSD License for more details.
# ------------------------------------------------------------------------
# Purpose:
#   Create a tableview and show the available font styles
#   in 2 columss name / fixed font / formatted_text...
# ------------------------------------------------------------------------

package require Tk
package require -exact tablelist_tile 6.0.1

package provide fontseldialog 0.1


namespace eval fontseldialog {

        variable widgetDefaults
        variable widgetImages
        variable widgetVars

        array set widgetDefaults {
                title "Font Selection Dialog"
                font ""
        }

        # initializing required images...
        set this_dir   [file dirname [info script]]
        set image_dir  [file join $this_dir "images"]
        set image_file [file join $this_dir "ImageLib.tcl"]

        proc LoadImages {image_dir {patterns {*.gif}}} {
                foreach p $patterns {
                        foreach file [glob -nocomplain -directory $image_dir $p] {
                                set img [file tail [file rootname $file]]
                                if { ![info exists images($img)] } {
                                        set images($img) [image create photo -file $file]
                                }
                        }}
                return [array get images]
        }

        if { [file exists $image_file] } {
                source $image_file
                array set widgetImages [array get images]
        } else {
                array set widgetImages [LoadImages \
                                [file join $image_dir] {"*.gif" "*.png"}]
        }

        proc GetFontInformation {} {
                variable widgetDefaults
                variable widgetVars

                # make shure to create fonts + data list only once
                if {[info exists widgetVars(font_info)] &&
                        [llength $widgetVars(font_info)] > 0} {
                        
                        return $widgetVars(font_info)
                }

                set widgetVars(font_info) [list]
        
                foreach font [lsort -dictionary [font families]] {
                
                        # top and bottom spacing for this font is very big,
                        # so let's filter out this specific font:
                        if {$font == "Cambria Math"} { continue }
                        
                        set fid [font create -family $font]
                        
                        set fmetrics ""
                        if {[font metrics $fid -fixed]} {
                                set fmetrics "*"
                        }
                
                        lappend widgetVars(font_info) \
                                [list [string trim $font] $fmetrics $widgetDefaults(sampletxt) $fid]
                }

                return $widgetVars(font_info)
        }

        proc ShowFont {fname fid} {
                variable widgetVars
                wm title $widgetVars(this) "Font selection dialog - $fname"
                # $widgetVars(wlabel) configure -font $fid
        }
        
        proc CancelCmd {} {
                variable widgetVars
                set widgetVars(is_ok) 2
        }
        
        proc OKButtonCmd {} {
                variable widgetVars
                set widgetVars(is_ok) 1
        }
        
        proc EnableOkButtonCmd {} {
                variable widgetVars                
                $widgetVars(ok_button) configure -state normal
        }

        proc DisableOkButtonCmd {} {
                variable widgetVars
                $widgetVars(ok_button) configure -state disabled
        }
        
                
        proc EntryBindingsCmd {tbl {mode "default"}} {
                variable widgetDefaults
                variable widgetVars
                
                switch -- $mode {
                        "default" {
                                set widgetVars(combobox_var) ""
                                set searchtxt [string trim $widgetVars(entry_var)]                                
                                # if {$searchtxt == "" } { return }
                        }
                        "refresh" {
                                # force refresh
                                set widgetVars(entry_var) ""
                                set widgetVars(combobox_var) ""
                                set searchtxt ""
                        }
                        "combo" {
                                set widgetVars(entry_var) ""
                                set searchtxt [string trim $widgetVars(combobox_var)]
                        }
                        default {
                                return -code error \
                                        "programmer's error: unknown $mode in proc EntryBindingsCmd"
                        }
                }

                $tbl selection clear 0 end
                $tbl delete 0 end

                set idx 0
                foreach item [GetFontInformation] {
                        set font [lindex $item 0]
                        set fid [lindex $item end]

                        if { $searchtxt == "" || \
                                 [string first $searchtxt $font] != -1} {
                        
                                $tbl insert end $item
                                $tbl cellconfigure "$idx,2" -font $fid
                                incr idx
                        }
                }
                
                $widgetVars(wstatus_label) configure -text \
                        "There are $idx fonts available."

                DisableOkButtonCmd
        }

        proc TextSearch {w string tag} {
                $w tag remove $tag 0.0 end
                if {$string == ""} {
                        return
                }
                set cur 0.0
                while 1 {
                        set cur [$w search -count length $string $cur end]
                        if {$cur == ""} {
                                break
                        }
                        $w tag add $tag $cur "$cur + $length char"
                        set cur [$w index "$cur + $length char"]
                }
        }
        
        # recursive function
        proc WinfoGetAllTextWidgets {wparent wlist} {
                upvar $wlist widget_list 
        
                foreach w [winfo children $wparent] {
                        if { [winfo class $w] == "Text" } {
                                lappend widget_list $w
                        }
                        WinfoGetAllTextWidgets $w widget_list
                }
        }

        proc ColorizeCmd {tbl textWidget key row col tabIdx1 tabIdx2 inStripe selected} {
                variable widgetVars
                
                if {! [info exists widgetVars(entry_var)] ||
                          [winfo class $textWidget] != "Text" } {
                        return
                }
                
                
                # -development-
                # set wtext_list [list]
                # WinfoGetAllTextWidgets $tbl wtext_list
                # puts "There are [llength $wtext_list] text widgets available."
                # foreach wtext $wtext_list { puts $wtext }
                
                set searchtxt [string trim $widgetVars(entry_var)]
                
                if {[string length $searchtxt] <= 1}  {
                        return
                }
                
                # #ce5555 / White
                $textWidget tag configure search \
                        -background LightYellow -foreground Black
                
                TextSearch $textWidget $searchtxt search
        }

        proc ComboBoxSelectedCmd {tbl w} {
                EntryBindingsCmd $tbl "combo"
        }

        # -------------------------------------------------------------------------
        # gui declaration
        # -------------------------------------------------------------------------
        
        proc fontseldialog {args} {
                variable widgetDefaults
                variable widgetImages
                variable widgetVars
                
                # "entia non sunt multiplicanda praeter necessitatem"
                #  - (use) no more things than necessary"
                array set widgetDefaults {
                        sampletxt "Entia non sunt multiplicanda praeter necessitatem."
                }
        
                set wparent ""
                set ind 0
                
                while { $ind < [llength $args] } {
                        switch -exact -- [lindex $args $ind] {
                                "-parent" {
                                        incr ind
                                        set wparent [lindex $args $ind]
                                        incr ind
                                }
                                "-title" {
                                        incr ind
                                        set widgetDefaults(title) [lindex $args $ind]
                                        incr ind
                                }
                                "-font" {
                                        incr ind
                                        set widgetDefaults(font) [lindex $args $ind]
                                        incr ind
                                }
                                default {
                                        puts "unknown option [lindex $args $ind]"
                                        return ""
                                }
                        }
                }
                
                set w $wparent.fontseldialog
                set widgetVars(this) $w
                catch {destroy $w}
                
                toplevel $w -class FontSelDialog
                wm title $w widgetDefaults(title)
                wm geometry $w "800x650+150+150"
                wm transient $w $wparent
                bind $w <KeyPress-Escape> "[namespace current]::CancelCmd"
                
                set fmain [ttk::frame $w.main -relief groove]
                pack $fmain -side bottom -fill x
                
                ttk::button $fmain.chk \
                                -text "Continue with selected font..." \
                                -compound left \
                                -image $widgetImages(dialog-ok) \
                                -command "[namespace current]::OKButtonCmd" \
                                -state disabled
                
                set widgetVars(ok_button) $fmain.chk
                
                ttk::button $fmain.cancel \
                                -text "Cancel" \
                                -image $widgetImages(dialog-close) \
                                -compound left \
                                -command "[namespace current]::CancelCmd" \
                                
                pack $fmain.chk $fmain.cancel -side left -expand true -padx 4 -pady 4
                
                # --------------------------
                # font selection gui
                # --------------------------

                set f [ttk::frame $w.help -height 20]
                pack $f -side bottom -fill x
                
                set widgetVars(wlabelframe) $f
                
                set msg "Hint: You might want to use one of the \"UI\" font styles"
                append msg "\nwhich are easy to read and look good for user interfaces."
        
                ttk::label $f.lbl -text $msg
                pack $f.lbl -anchor center
                
                set widgetVars(wlabel) $f.lbl
                
                set f [ttk::frame $w.entry]
                pack $f -side top -fill x

                ttk::label $f.lcombo -text "Filter: "
                ttk::combobox $f.combo \
                        -width 5 -state readonly \
                        -values [list "" "ExtB" "FB" "MS" "MT" "Sans" "UI" "Hand" "Script" "Light"] \
                        -textvariable "[namespace current]::widgetVars(combobox_var)"

                set widgetVars(wcombobox) $f.combo
                        
                ttk::label $f.lbl \
                        -image $widgetImages(dialog-search)
                
                ttk::entry $f.entry \
                        -width 40 \
                        -textvariable "[namespace current]::widgetVars(entry_var)"

                set widgetVars(wentry) $f.entry

                ttk::button $f.bttn \
                                -compound left \
                                -image $widgetImages(dialog-refresh) \
                                -style Toolbutton

                set widgetVars(wentry_bttn) $f.bttn
                                
                pack $f.lcombo $f.combo $f.lbl -side left -padx 5 -pady 5
                pack $f.entry -side left -padx 5 -pady 5 -fill x -expand true
                pack $f.bttn -side left -padx 2
                
                set tf $w.tf
                ttk::frame $tf
                set tbl $tf.tbl
                set vsb $tf.vsb
                
                tablelist::tablelist $tbl \
                                -columns {
                                        0 "Font Name"        left
                                        0 "fixed" center
                                        0 "Sample text" left
                                        0 "Font ID" right } \
                                -labelcommand tablelist::sortByColumn \
                                -yscrollcommand [list $vsb set] -width 0 \
                                -spacing 1 \
                                -showseparators yes \
                                -selectmode single \
                                -font APP_FONT_STD_NORMAL \
                                -stripebackground #E0E8F0 \
                                -selectbackground #A9D0F5 \
                                -stretch all
                                
                $tbl configure -colorizecommand "[namespace current]::ColorizeCmd"
                $tbl columnconfigure end -hide yes
                                
                ttk::scrollbar $vsb -orient vertical -command [list $tbl yview]
                
                grid $tbl -row 0 -rowspan 2 -column 0 -sticky news
                grid $vsb -row 0 -rowspan 2 -column 1 -sticky ns
                
                grid rowconfigure    $tf 1 -weight 1
                grid columnconfigure $tf 0 -weight 1
                pack $tf -side top -expand yes -fill both


                set f [ttk::frame $w.status]
                pack $f -side top -fill x

                ttk::label $f.status
                # -image $widgetImages(dialog-search)
                
                set widgetVars(wstatus_label) $f.status

                pack $f.status -anchor center -padx 5 -pady 5
                
                bind [$tbl bodypath] <Motion> {+
                        set t [winfo parent %W]
                        set x [expr {%x + [winfo x %W]}]
                        set y [expr {%y + [winfo y %W]}]
                        
                        # enable move-over effect,
                        focus $t
                        $t configure -activestyle frame
                        $t activate "@$x,$y"
                        
                        ::fontseldialog::ShowFont \
                                [lindex [$t get "@$x,$y"] 0] \
                                [lindex [$t get "@$x,$y"] end]
                }

                bind [$tbl bodypath] <Leave> {+
                        set t [winfo parent %W]
                        
                        $t configure -activestyle none
                }                
                
                bind [$tbl bodypath] <ButtonRelease-1> {+
                        set t [winfo parent %W]
                        set x [expr {%x + [winfo x %W]}]
                        set y [expr {%y + [winfo y %W]}]
                
                        # if a tablelist has only a few entries, an "empty area"
                        # is shown after the last row 
                        # the following if clause ensures that a click in
                        # this area simply has no effect
                        set row [lindex [split [$t containingcell $x $y] ","] 0]
                        if {$row == -1} {
                                ::fontseldialog::DisableOkButtonCmd
                        } else {
                                set cell [$t nearestcell $x $y]
                                ::fontseldialog::EnableOkButtonCmd
                        }
                }

                bind [$tbl bodypath] <Double-ButtonPress-1> "[namespace current]::OKButtonCmd"
                
                bind $widgetVars(wentry) \
                        <KeyRelease> "[namespace current]::EntryBindingsCmd $tbl"
                $widgetVars(wentry_bttn) configure \
                        -command "[namespace current]::EntryBindingsCmd $tbl refresh"

                bind $widgetVars(wcombobox) <<ComboboxSelected>> \
                        "[namespace current]::ComboBoxSelectedCmd $tbl %W"
        
                # ---------------------------
                # fill tablelist with content
                # ---------------------------

                set default [lindex [$tbl configure -font] 3]
                
                set idx 0
                foreach item [GetFontInformation] {
                        set font [lindex $item 0]
                        set fid [lindex $item end]
                        
                        $tbl insert end $item
                        $tbl cellconfigure "$idx,2" -font $fid
                        incr idx
                }
                
                $widgetVars(wstatus_label) configure -text \
                        "There are $idx fonts available."

                # perform font name preselection (if any)
                # ---------------------------------------

                if { $widgetDefaults(font) != ""} {
                
                        # try to find font name and calculate index
                        set data [list]
                        foreach litem [$tbl get 0 end] {
                                lappend data [lindex $litem 0]
                        }
                        
                        if { [set idx [lsearch $data $widgetDefaults(font)]] != -1 } {

                                # bummer !
                                $tbl selection set $idx
                                $tbl see [expr {$idx -3}]
                                EnableOkButtonCmd
                        }
                }
                
                after 6000 "catch {pack forget $widgetVars(wlabelframe)};"

                # --------------------------
                # --------------------------
                
                # wait user
                grab $widgetVars(this)
                tkwait variable "[namespace current]::widgetVars(is_ok)"
                grab release $widgetVars(this)
                
                if { $widgetVars(is_ok) == 1 } {
                        # read actual selection:
                        set sel [$tbl curselection]
                        set retval [string trim [lindex [$tbl get $sel] 0]]
                } else {
                        set retval ""
                }

                # clean fonts before leaving the dialog (if that matters)...
                foreach item [GetFontInformation] {
                        set fid [lindex $item end]
                        
                        set widgetVars(font_info) [list]
                        catch {font delete $fid}
                }
                
                destroy $widgetVars(this)
                return $retval
        }
}
  • fontseldialog_test.tcl
set dir [file dirname [info script]]

set auto_path [linsert $auto_path 0 [file join $dir "."]]
set auto_path [linsert $auto_path 0 [file join $dir ".."]]
set auto_path [linsert $auto_path 0 [file join $dir "../../lib"]]


# test-run ...

package require Tk
package require tile

package require -exact tablelist_tile 6.0.1
package require fontseldialog 0.1


wm withdraw .

set showconsole 0
if { $showconsole && $::tcl_platform(platform) == "windows"} {
        console show
        console eval {wm protocol . WM_DELETE_WINDOW {exit 0}}
}

set rval [fontseldialog::fontseldialog \
                        -parent "" \
                        -title  "Select Font Style:" \
                        -font   "Comic Sans MS" \
                ]

puts "Selection return value is: \"$rval\""
  • pkgIndex.tcl
package ifneeded fontseldialog 0.1 \
        [list source [file join $dir fontseldialog.tcl]]
  • ImageLib.tcl
# ImageLib.tcl ---
# Automatically created by: CreateImageLib.tcl

set images(dialog-clear) [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABQAAAAUCAYAAACNiR0NAAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
WXMAABGwAAARsAHIJ/VUAAAAB3RJTUUH4QEaCTEiD+SBFQAAA0tJREFUOMu1lM9vVFUUx79vOvOm
M9MOLWJKpAmx7T+g3WioUMvYuBPSCIQ0uDASVyzY6J8gCxPiT4hglNB2OsO0aaJxeH3zyxh/YRWw
UrugKKhtdDozjzrvzbx73/26qNO0UIREPclZ3JNzPjnn3vO9Gkn8l+a7M+BJCSnFPxYppeC67v2B
nvIwOZXixGSKnvLuCczmTH5w7iylEPcGKqWQSMb5yI4d6OzsRDIZp9oEaphpCiHw5BO7cPrMu3TF
HZ2ShOPUcH7kQ37+xWdsWCZrMp4YJUk03MwaHE+M0BUuSXJ+fo7vnHqTjmOv5fgAwO9vgq4H0Xgg
IQUGnt6Lh7dtQyK12qlhprm4+CsOPH8YtlMFQWja6p2760dvkD1PYix+ntnsNEnSqTkkyWkzzZNv
vM6x8RGS5O0Vi1JKXv3+Ct96+yTrbh3rp9hwkJ7E2PgozYxBkrQdmySZy2dIktZKmcIT/OrSl3zv
7Cm6rruh/i5gwxMXxmiY6b8hFdq1KkvlIl23zkszX3Nk9Bwtq7JprW+ztRjaf0C79sMsCp/mEPD7
UbHKAIAbCzeQyRgYHHx2Jhrd8mCLDQCZrMGOju3Y/VQ/bMeGHtBRFwI7H92Jxx/rRaGQ6/U88WDA
bM7k0tIiDh48DGulgnCoBX/8vowtrVFYt0vo69sDv9+PickU7wucNtNcWvoNw8MvoGyV0KwHceXy
d5iaSqFQyCMSboW1UsLA3hj0oI7khTiVUncDhRBIpz9mvV7H/n1DWC4V0RwM4ZtvZ7Dw0wKOvvTy
Cdu2YUxfRKg5gkqlhD39/QhHwkhNJCjWqcUHAFTErV9uoaNjO5pDIUTCLZidvYq5a7OIDcQQbW17
NRYb1Ny6i1wui0ikBT7Nh57uHvw4P4c/q9VYA6g11FG1qzjz/mn27doNDUQ+n8ehQ8MI6sETtZrz
SjAYTJLo+uTiR71t7W3o6e5BMjGOY8eOP9Pe1m6uAZVSEEJAColKpcxkKg5N82Hfc0OIRqPdTU1N
C7quQ0oJIWSXY1evG2YaN2/+jCNHXsRDW7dquq4jEAhA07TVxW5AhRAolZaPlsvlLiEEpJQblSQl
hBCwLAvFYvE1ISRc14VSai1H+99/7H9rfwF2imSw0yqcowAAAABJRU5ErkJggg==
}]
set images(dialog-close) [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QAAAAAAAD5Q7t/AAAACXBI
WXMAAA3XAAAN1wFCKJt4AAAACXZwQWcAAAAQAAAAEABcxq3DAAACR0lEQVQ4y6VTQU/iQBh9U7qQ
lrYYg7uLlOXA3kyMRy9rW7xx4LQHf2LPvRETbfXkgcSQGE8eQFi2Io20WCyd6ezBhYgHL36nyffe
fPneezOEc47PlLg6uJYl5mYzG4SAadqJeX5O3xJdyxJzYWgD2MCFFUimU0euVltytdoi06njWtbG
cBIETlHXW7Kut0gQrHERAPhkYiu1mlk7PpZACAadjjnv9x3XstoAgIcHp1ivm3qzKYFzDDodM7q/
twH8FgEgoxTZcolssUAWhtANQxqcnprRcOgAgKrrpm4YEvV9CJr2ymUMAEA453AJEdNGw1ErFbPe
bEpZFEHQNNx73jMA1AyjmEURBEXB4OwsDsdj78vdXdvknJJVCi4hYlKvO2qlYvw4OpKz+Rw5VQUA
sDCEoKoYXFzE0XjsFfr9tsk5XW+wNosQcaHrjra7+6t6eKiA/g9CFDG6upqHo9GlNByuL2/EuCpG
KehyCbpYAFn22kxT0CQBo/Q9HRsSwp0dRy6XjerBgZwlCXKS9Dr05QVCPo/R9XUcPz562mSyKcEl
RHza3nbkrS3j+/6+zJdLkHweDzc3cwD4urenrHp/e704fnrytoKgbXJOBQAISiU7Xywa5UZDTmcz
MEox7Hbjme9fznz/ctjtxoxSpGGIcqMh54tFIyiV7LUHjDGwNEUaxwCAye1t/BJFXvn5uQ0Aj4w5
f3o9Y+fnTxmcI0tTsPfvwC8UnIKiGACQzOfetyRZ6/wI3zBxnMvZAFBh7ORtVB/h5LPf+R+0911L
hE5qiwAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAxMC0wMi0xN1QwNzowMzozMy0wNzowMBY/EYkAAAAl
dEVYdGRhdGU6bW9kaWZ5ADIwMTAtMDEtMTFUMDk6MTI6NDItMDc6MDDvvfybAAAANHRFWHRMaWNl
bnNlAGh0dHA6Ly9jcmVhdGl2ZWNvbW1vbnMub3JnL2xpY2Vuc2VzL0dQTC8yLjAvbGoGqAAAABl0
RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAAATdEVYdFNvdXJjZQBHTk9NRS1Db2xv
cnOqmUTiAAAAMXRFWHRTb3VyY2VfVVJMAGh0dHA6Ly9jb2RlLmdvb2dsZS5jb20vcC9nbm9tZS1j
b2xvcnMvUB216wAAAABJRU5ErkJggg==
}]
set images(dialog-ok) [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
WXMAABGwAAARsAHIJ/VUAAAAB3RJTUUH4gMCEiUV4H3hYAAAAfJJREFUOMulk1tI03EUxz+/XZi7
OOlvWGLRBYmgYAbaGgiVUMgcVA89lC9JIvXQZUGjCEIIgiAcjB4iih6iXjKCSPKphzKDkuWg2Lz0
8G+rzVVb0cLm1NNDW0imLTxPB37n+zm331EiwlLMwBKtbED37XY5FNwk9wevip6M+f8LEIuHZWrm
Eyf3B/jyY4RQ37Ge0pvpX2LXaWXfuspNh+8AEf0hJuM6NtZtK7+Fs23BXEO9i7HUIKu1LTyNPMHb
1BEqC9D38m7DgxchVtZUYFI2Hj3vp6v1InXL15+YBxhNDEtn0CMTmcTvvT57fe9Vm8dLMjNKYdLC
zLSNxg0tam4SE0A6m5Bzt7zsa95L4OZOWlwdUl1Zy6wkyeXzOK0rGIgM0X2wd16VSkQIXN8jmjZF
daUdEQOJ9Gei+jt2NbmZLKT5+g1qHG6O+C6ovwIA/NdaBbKsqdWYljwOyzKyuQ+YjRrh2Dh3zoyo
RT9SsKtfbd/cyePwAFIw8DETx6QsxPS3HPVdXnDQ6s9bGE+8kUu9h6lyfMdoMGC3NHK+/YZSShkA
BczKXFHRV4AZsHrosabSSTl+Zbc0n0L0uC6p9xPD0WjUD1QB1mLsr+QiUoIYi1uxrmVHxRBiFsSs
Ue8EnICtKDYBxpJOLXbOSilVrHLBoJ+h/c25hpqBXwAAAABJRU5ErkJggg==
}]
set images(dialog-refresh) [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABmJLR0QAAAAAAAD5Q7t/AAAACXBI
WXMAAA3XAAAN1wFCKJt4AAAACXZwQWcAAAAWAAAAFgDcxelYAAAD1UlEQVQ4y7WUTWxVRRSAv3Pv
fX2vrX30V6CFtggqUUuEACYqYSPBRBISo9GFGhe6Ihij7khcYGKIPwtdCTUujGIibHSjgaiJGgkY
UcGFQJG0tFADNIX2te/eOTPHxa2vvHYncZJJbmbO/WbmO2dGzIz/oyUAm178ZFsURx96H3pvBRbH
0Ujw4YWfB585mgAgDD68YVVvf08HcRwRR7KoRwIigpkRDHywRf3C6LXe70+cGwT6EwCvvm95V5lz
YzdICjHJHDyJbwJHggAGhJtg6ue+fWDl7Utw6vtqKsxCHmyBKAhBBBHYtKaD9ava6CwXqaTK6NVZ
fvlrgpErMwTLgYVE0DTgQ97NwrxjC4bTQPCGF0Mk8PSWfjaubq/5a2yI6Wwpcv+qVv4cu8Hhn0aZ
dcpzW/v54OtzeG+oGhbsJrAZ6gPqPQis62+tgy5sa3vKvPTYnfx9vcqa5S049agPOO/5t8pqKpx6
vM+PsXl1mWBGZSZl/+HvmLhRoburlae2P0BXWwsA5aYC5aYCAKoBVY+qr6mI5lXkE94H7unrIBKh
sVTg9CXPVW3n5HDKrn2f8fGXP1LNXN0JnPOoBjLnF6rIB1U9EYZTpZDExFFMsaUDEaGh2ETbbW1c
nFSSOF4AdmgwnPMLkmf5oFOPhcDLew8wNF5BBHrvewgRAWBlVzOvPDFAEkd14EzzikidLnAcAlmm
OPWEKOLAm7vrfpzNlDcO/sqZC5fZsesoYS5JNqdxYPNWxidmSF2+sbodp05R57Ek1EHVB/a8d5jh
6SaSYhOdd2zADD7f80gt5ofTY7x96HdcNr/jqOY4U5wqqvVgp5716+6lodhIlmke57Q2H0Jg5OIY
zvk5FQsuSDVTnPNg9eDGYoFntw+w48G7OPjtWU4OXeHuntY5qJE5z1fHzuJcM2kaL66KNHM4pwh5
xo+fOk9fdyfLOpcA0NZSZNfOgdqCPgTiKOKPs8MMT0CUeNLMLa6KNFMyp4gYx0+dZ/e+QyTiee35
7Ty+bePiJzKKmJicZu/gEYJ0oE6pZtQci5mxZue71r2ym0pViUWw6YtE5V7AqE5eYkVrxJOPbmbL
xrW0L2mmMpty7Lch3v/0G2YLS4mSIiEYTaWESyNjDH3xqsxfaecIPmAClJYRfECAQrmby2mVdw4e
Y99HRwiagcQUGlsolZeDJHjNy08d9SrARitTlRWlxlJ+GSTKX14RRAyKJRqKPQtkGGaAGYiBGZWp
aSz4cRFpTgBmxs+8Hjr635q6XujkFpppen1q5MR+oE3MDBEpAN3AUmDyP3LbgVlgDLj2D6PDY5hT
ZmYmAAAAJXRFWHRkYXRlOmNyZWF0ZQAyMDEwLTAxLTExVDA5OjEyOjUyLTA3OjAwUkpEuQAAACV0
RVh0ZGF0ZTptb2RpZnkAMjAxMC0wMS0xMVQwOToxMjo1Mi0wNzowMCMX/AUAAAA0dEVYdExpY2Vu
c2UAaHR0cDovL2NyZWF0aXZlY29tbW9ucy5vcmcvbGljZW5zZXMvR1BMLzIuMC9sagaoAAAAGXRF
WHRTb2Z0d2FyZQB3d3cuaW5rc2NhcGUub3Jnm+48GgAAABN0RVh0U291cmNlAEdOT01FLUNvbG9y
c6qZROIAAAAxdEVYdFNvdXJjZV9VUkwAaHR0cDovL2NvZGUuZ29vZ2xlLmNvbS9wL2dub21lLWNv
bG9ycy9QHbXrAAAAAElFTkSuQmCC
}]
set images(dialog-search) [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABmJLR0QAAAAAAAD5Q7t/AAAACXBI
WXMAAA3XAAAN1wFCKJt4AAAACXZwQWcAAAAWAAAAFgDcxelYAAAEVElEQVQ4y7WT209UVxTGv3Xm
DsMwcxhgRIyDVkGMZYy1aRWiVaJtkJvpQ31pbN/atA99aI1RmxBNGPGlf0ANSU1No6maam1VRlCw
iSi1tNXCjBEGGS7OgbngzDlnzpy9++BgjC3oiyv5spK9d35r5dtrEeccryKEV0IFYPyfM2rvONJI
oPcA1HNAJGAcoFEOdnz/Vwd/ehkwPWuF3+93QdC/q6yq2rVxw0aIohtWqxWKLCMWn8WNG714MDJy
nTj7bN++Q3+9FNjv93sFA+9uam72rqhYhfN9w/HuwWn9XnjWsdYrJt+pKTXs2lzpDIcf4Oy5s5Jm
0H0HvjgQebHHBv2b1tbdXrGojLUcupC8GUrO7qqrShz9dNtY7fqV0Yu/Rx81H7yQKBQ9rKmxyW3Q
8ENbW5txIbARANqPtddVLK9oLi9fjtavL87t2fH6RP36pUVmo2DSdKa57JZM5TKX8mPfg+G9Hd1V
5w43OFavXl07HAzuAXBiwY6Js899Ph86f74TXVrqnN5U7bEDHAycA2CCQFmDAFbkzIszMjw8Fbgb
q6nxgYjvWNQKAlYaTUZ03XnE3qgskzWdZRVNl1WNxTXGEpzzpJbVZ6YTmdHSYuf4L7cnsjabDZxh
66JWcGAZYzrGpZRotZpG5EzWxMmgMQgZ4iyjM6j992O3NT2bsedbDAP3I9uzWQ2qmsl70RwrRqMJ
Ze78mVAkwVctdSSJSIaeVTKMRW8FZ/qDE6k0BIiJOWWZaDfNJpPJEjWjPlwczBGQ0/Leel+J4cLt
iEMwGXvFAlsildbGY3I2TAJ/LBBcnME6NR2r2FlTDFVVoanK2OLjJuDXoaF/8FFDjZvrWvnoRKwk
MpuaiymqDAACezLs4QnpNUHX1n/csK7kZn8/VEX9ftGOxcLiM6FQ6Lfq6pFNJ/Zvs3/o79429She
XFLkuGUvsFji8bQrKiXfthr5lhMHttuj0UkMDg5mhoaDsRdu3rFjbR5OloGW5pYyr3clzvcFZ3v+
nNbvjs441y53xbf6PKbGzZXO4eA9dHZ2Ih6PQ5KktMVkazh9+nTPgmAAOHr08DpGwrcrvBVv1tbW
weUUYbXZoMgypBkJPT3duN7bq2QzGWvVmjUoK1uCrq5AStHSTadOnrm6IHg+2juO7CZOn0BAOThK
VVVNyLIaUNT0pUuX++J2u+1cc+O7eUs8HpjMZgQCgZSsplpPnTxzZVHw00ui+Q+mnAAA1Rs2vCU6
HBd31m8p8HiWwGKxoKurKyWrqaedC8+BDERkJiIbEeUDcORUCMA5r3sDA0NTk9H3L1/peTw5NQlV
VVFXV5cvwHiciIxEREIOSERkAmAGYMnJBiAPQD6AglwBJwAXgML7Q38HxyKRDy5fuTYXHgtDkqLQ
s7rT7XbbAJjnN48vIJazQH/m3Xxm4VDoDzCh5WrPjQ6bxVwuCPhSkiQdgP4fj+mJscIzMjyXkSuo
P5fnxTnn+BdfFBTdhrqWWgAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAxMC0wMS0xMVQwOToxMzowMy0w
NzowMFMfKlcAAAAldEVYdGRhdGU6bW9kaWZ5ADIwMTAtMDEtMTFUMDk6MTM6MDMtMDc6MDAiQpLr
AAAANHRFWHRMaWNlbnNlAGh0dHA6Ly9jcmVhdGl2ZWNvbW1vbnMub3JnL2xpY2Vuc2VzL0dQTC8y
LjAvbGoGqAAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAAATdEVYdFNvdXJj
ZQBHTk9NRS1Db2xvcnOqmUTiAAAAMXRFWHRTb3VyY2VfVVJMAGh0dHA6Ly9jb2RlLmdvb2dsZS5j
b20vcC9nbm9tZS1jb2xvcnMvUB216wAAAABJRU5ErkJggg==
}]