Version 10 of A TclOO Tkhtml 3.0 megawidget - example of how to render html+css
Updated 2017-01-26 22:20:35 by JOBJOB - 2017-01-23
Here is an example code which shows, how to render a html file - styled with css. Although nothing brand new, the Tkhtml3 widget works surprisingly well with html-code + e.g. Bootstrap css framework.
I find it very convenient to have a lightweight html widget available, which might be used as a docu-reader, help-viewer, etc...
Since the interface between tkhtml-2 and tkhtml-3 changed, it took me quite a while to figure out, how to render a page with Tkhtml3.
# -----------------------------------------------------------------------------
# html3widget.tcl ---
# -----------------------------------------------------------------------------
# (c) 2016, 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:
# A TclOO class implementing the html3widget megawidget.
# Might be usefull as a starting point.
# -----------------------------------------------------------------------------
# TclOO naming conventions:
# public methods - starts with lower case declaration names, whereas
# private methods - starts with uppercase naming, so we are going to use CamelCase ...
# -----------------------------------------------------------------------------
# for development: try to find autoscroll, etc ...
# set this_file [file normalize [file dirname [info script]]]
# where to find required packages...
# set auto_path [linsert $auto_path 0 [file join $this_file ".."]]
# COMMANDS:
# html3widget::html3widget path args
#
package provide html3widget 0.1
package require -exact Tkhtml 3.0
package require scrolledwidget
package require findwidget
# replace http package with native Tkhtml functionality:
catch {package require http}
namespace eval html3widget {
variable image_dir
variable image_file
set this_dir [file dirname [info script]]
set image_dir [file join $this_dir "images"]
set image_file [file join $this_dir "ImageLib.tcl"]
variable cnt 0
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]
}
# ---------------------------------------------------------------
# read images from library file or alternatively one by one
# ---------------------------------------------------------------
if { [file exists $image_file] } {
source $image_file
array set appImages [array get images]
} else {
array set appImages [::html3widget::LoadImages \
[file join $image_dir] {"*.gif" "*.png"}]
}
# ---------------------------------------------------------------
# html3widget.TCheckbutton - checkbutton style declaration
ttk::style element create html3widget.Checkbutton.indicator \
image [list \
$appImages(checkbox-off) \
{disabled selected} $appImages(checkbox-off) \
{selected} $appImages(checkbox-on) \
{disabled} $appImages(checkbox-off) \
]
ttk::style layout html3widget.TCheckbutton [list \
Checkbutton.padding -sticky nswe -children [list \
html3widget.Checkbutton.indicator \
-side left -sticky {} \
Checkbutton.focus -side left -sticky w -children { \
Checkbutton.label -sticky nswe \
} \
] \
]
ttk::style map html3widget.TCheckbutton \
-background [list active \
[ttk::style lookup html3widget.TCheckbutton -background]]
proc html3widget {path args} {
#
# this is a tk-like wrapper around my... class so that
# object creation works like other tk widgets
#
variable cnt; incr cnt
set obj [Html3WidgetClass create tmp${cnt} $path {*}$args]
# rename oldName newName
rename $obj ::$path
return $path
}
oo::class create Html3WidgetClass {
constructor {path args} {
my variable hwidget
my variable widgetOptions
my variable widgetCompounds
my variable isvisible
set isvisible 0
array set widgetCompounds {
dummy 0
}
# declaration of all additional widget options
array set widgetOptions {
-dummy {}
}
# incorporate arguments to local widget options
array set widgetOptions $args
# we use a frame for this specific widget class
set f [ttk::frame $path -class html3widget]
# we must rename the widget command
# since it clashes with the object being created
set widget ${path}_
my Build $f
rename $path $widget
my configure {*}$args
}
destructor {
# adds a destructor to clean up the widget
set w [namespace tail [self]]
catch {bind $w <Destroy> {}}
catch {destroy $w}
}
method cget { {opt "" } } {
my variable hwidget
my variable widgetOptions
if { [string length $opt] == 0 } {
return [array get widgetOptions]
}
if { [info exists widgetOptions($opt) ] } {
return $widgetOptions($opt)
}
return [$hwidget cget $opt]
}
method configure { args } {
my variable hwidget
my variable widgetOptions
if {[llength $args] == 0} {
# return all tablelist options
set opt_list [$hwidget configure]
# as well as all custom options
foreach xopt [array get widgetOptions] {
lappend opt_list $xopt
}
return $opt_list
} elseif {[llength $args] == 1} {
# return configuration value for this option
set opt $args
if { [info exists widgetOptions($opt) ] } {
return $widgetOptions($opt)
}
return [$hwidget cget $opt]
}
# error checking
if {[expr {[llength $args]%2}] == 1} {
return -code error "value for \"[lindex $args end]\" missing"
}
# process the new configuration options...
array set opts $args
foreach opt_name [array names opts] {
set opt_value $opts($opt_name)
# overwrite with new value
if { [info exists widgetOptions($opt_name)] } {
set widgetOptions($opt_name) $opt_value
}
# some options need action from the widgets side
switch -- $opt_name {
-dummy {}
default {
# -------------------------------------------------------
# if the configure option wasn't one of our special one's,
# pass control over to the original tablelist widget
# -------------------------------------------------------
if {[catch {$hwidget configure $opt_name $opt_value} result]} {
return -code error $result
}
}
}
}
}
method unknown {method args} {
#
# if the command wasn't one of our special one's,
# pass control over to the original tablelist widget
#
my variable hwidget
if {[catch {$hwidget $method {*}$args} result]} {
return -code error $result
}
return $result
}
}
}
# --------------------------------------------------------
# Public Functions / implementation of our new subcommands
# --------------------------------------------------------
oo::define ::html3widget::Html3WidgetClass {
method get_htmlwidget {} {
my variable hwidget
return $hwidget
}
method parsefile {html_file} {
my variable hwidget
my variable html_basedir
if { ![file exists $html_file] || ![file readable $html_file]} {
return
}
set html_basedir [file dirname $html_file]
set fp [open $html_file "r"]
set data [read $fp]
close $fp
$hwidget reset
$hwidget parse -final $data
}
method showhideSearchWidget {} {
my variable widgetCompounds
my variable isvisible
set frm $widgetCompounds(searchframe)
# the -before argument is *very* important
# to keep track of the required pack order
if { $isvisible == 0 } {
set isvisible 1
pack $frm -before $widgetCompounds(scrolledw) -side top -fill x
} else {
set isvisible 0
pack forget $frm
}
}
method showSearchWidget {} {
my variable widgetCompounds
my variable isvisible
set frm $widgetCompounds(searchframe)
if { $isvisible == 1 } { return }
set isvisible 1
pack $widgetCompounds(searchframe) \
-before $widgetCompounds(scrolledw) \
-side top -fill x
}
method hideSearchWidget {} {
my variable widgetCompounds
my variable isvisible
if { $isvisible == 0 } { return }
set isvisible 0
pack forget $widgetCompounds(searchframe)
}
# --------------------
# Private Functions...
# --------------------
method GetImageCmd {uri} {
# see as well:
# http://wiki.tcl.tk/15586
#
my variable html_basedir
# if the 'url' passed is an image name
if { [lsearch [image names] $uri] > -1 } {
return $uri
}
# if the 'url' passed is a file on disk
set fname [file join $html_basedir $uri]
if { [file exists $fname] } {
#create image using file
image create photo $uri -file $fname
return $uri
}
# if the 'url' is an http url.
if { [string equal -length 7 $uri http://] } {
set token [::http::geturl $url]
set data [::http::data $token]
::http::cleanup $token
image create photo $uri -data $data
return $uri
}
}
method StyleSheetHandler {node} {
#
# implementations of application callbacks to load
# stylesheets from the various sources enumerated above.
#
my variable hwidget
my variable html_basedir
my variable stylecount
set href [$node attr "href"]
global "$href"
# the variable contains the content of the css
set fp [open [file join $html_basedir $href] "r"]
set href_content [read $fp]
close $fp
if { ![info exists stylecount] } { set stylecount 0 }
incr ::stylecount
set id "author.[format %.4d $::stylecount]"
$hwidget style -id $id.9999 $href_content
}
method ImageTagHandler {node} {
# puts [$node attr "src"]
my GetImageCmd [$node attr "src"]
}
method ScriptHandler {node} {
my variable hwidget
# not implemented
}
method ATagHandler {node} {
my variable hwidget
if {[$node tag] == "a"} {
set href [string trim [$node attr -default "" href]]
if {[string first "#" $href] == -1 &&
[string trim [lindex [$node attr] 0]] != "name" } {
# console show
# puts "href: $href"
# puts "attr: [lindex [$node attr] 0]"
$node dynamic set link
}
}
}
method Build {frm} {
my variable widgetCompounds
my variable hwidget
set f [ttk::frame $frm.wmain]
pack $f -side bottom -fill both -expand true
set fsearch [ttk::frame $f.search -height 15]
### 'll be packed later on via binding
set widgetCompounds(searchframe) $fsearch
set sc [scrolledwidget::scrolledwidget $f.sc]
pack $sc -side bottom -fill both -expand 1 -padx 2 -pady 2
# required to take care about the pack order
set widgetCompounds(scrolledw) $f.sc
# --------------------------
# html 3 widget goes here...
# --------------------------
html $f.html \
-mode quirks \
-parsemode "xhtml" \
-zoom 1.0 \
-imagecmd "[namespace code {my GetImageCmd}]"
pack $f.html -side left -fill both -expand true
set hwidget $f.html
$sc associate $hwidget
# register style sheet handler...
$hwidget handler "node" "link" "[namespace code {my StyleSheetHandler}]"
$hwidget handler "node" "img" "[namespace code {my ImageTagHandler}]"
$hwidget handler "node" "a" "[namespace code {my ATagHandler}]"
$hwidget handler "script" "script" "[namespace code {my ScriptHandler}]"
# create the findwidget
set wfind [::findwidget::findwidget $fsearch.find]
pack $wfind -side left -fill x -expand true
# tell the search widget where to communicate to
# and which command to execute too, when the search functionality is done
$wfind register_htmlwidget $hwidget
$wfind register_closecommand "[namespace code {my hideSearchWidget}]"
# beautify at last...
set wlabel [$wfind getlabelwidget]
$wlabel configure -text "" \
-image $::html3widget::appImages(system-search)
set wbutton [$wfind getbuttonwidget]
$wbutton configure -text "" \
-image $::html3widget::appImages(dialog-close)
bind all <F3> \
"[namespace code {my showhideSearchWidget}]"
# perhaps, makes the behavor of bindings more "reactive" ?
tk_focusFollowsMouse
}
}
# ---
# EOF
# ---
Demo Code:
# for development: try to find autoscroll, etc ...
set dir [file normalize [file dirname [info script]]]
# where to find required packages...
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 "../../00-lib"]]
package require Tk
package require TclOO
package require -exact Tkhtml 3.0
# html3widget dependencies:
# replace http package with native Tkhtml functionality:
catch {package require http}
package require scrolledwidget
package require findwidget
package require html3widget
# to do: font re-sizing
# search functionality
#
set fnames [font names]
set fsize 10
set ffamily "Courier"
font create APP_FONT_STD_NORMAL -family $ffamily -size $fsize -weight normal
font create APP_FONT_STD_BOLD -family $ffamily -size $fsize -weight bold
font create APP_FONT_SMALL_NORMAL -family $ffamily -size [expr {$fsize - 2}] -weight normal
font create APP_FONT_BIG_BOLD -family $ffamily -size [expr {$fsize + 0}] -weight bold
font create APP_FONT_STD_NORMAL_FIXED -family "Courier" -size $fsize -weight normal
font create APP_FONT_STD_BOLD_FIXED -family "Courier" -size $fsize -weight bold
font create APP_FONT_BIG_BOLD_FIXED -family "Courier" -size [expr {$fsize + 0}] -weight bold
# --------------------
# demo starts here ...
# --------------------
# catch {console show}
set w [toplevel .test]
wm withdraw .
wm title $w "Test"
wm geometry $w "800x600"
# wm minsize $w 400 200
wm protocol $w WM_DELETE_WINDOW "exit 0"
set ft [ttk::frame $w.top]
pack $ft -padx 4 -pady 4 -side top -fill x
ttk::label $ft.lbl -text "Tkhtml-3.0 widget test!"
pack $ft.lbl -anchor center
set fb [ttk::labelframe $w.bottom -text "Browser:"]
pack $fb -padx 4 -pady 4 -side bottom -fill both -expand true
# -----------------------------------------------
set html3 [html3widget::html3widget $fb.html3]
pack $html3 -side bottom -fill both -expand true
# -----------------------------------------------
set html_file [file join $dir "demo_doc/tkhtml_doc.html"]
set html_basedir [file dirname $html_file]
$html3 parsefile $html_file
# $html3 showSearchWidget
bind all <MouseWheel> {
set w %W
while { $w != [winfo toplevel $w] } {
catch {
set ycomm [$w cget -yscrollcommand]
if { $ycomm != "" } {
$w yview scroll [expr int(-1*%D/36)] units
break
}
}
set w [winfo parent $w]
}
}
JOB - 2017-01-26
Extension to support find functionality in the html3widget:
# -----------------------------------------------------------------------------
# findwidget.tcl ---
# -----------------------------------------------------------------------------
# (c) 2017, Johann Oberdorfer - Engineering Support | CAD | Software
# johann.oberdorfer [at] gmail.com
# www.johann-oberdorfer.eu
# -----------------------------------------------------------------------------
# Credits:
# Code derived from:
# http://tkhtml.tcl.tk/hv3_widget.html
# danielk1977 (Dan)
#
# 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:
# A TclOO class implementing the findwidget megawidget.
# Might be usefull as a starting point.
# -----------------------------------------------------------------------------
# Widget Command:
# findwidget::findwidget path
#
#
# Widget Specific Options:
# configure interface not implemented
# Widget Sub-commands:
#
# getlabelwidget
# returns the label widget, might be used to
# configuration the label with custom image, etc...
#
# getbuttonwidget
# returns the button widget
#
# register_htmlwidget <html3 widget>
# call this function to establisch communication
# between findwidget and html3widget
#
# register_closecommand <command>
# specify a command to be executed, once the widget
# is set to ho-show
#
#
package provide findwidget 0.1
namespace eval findwidget {
variable cnt 0
proc findwidget {path args} {
#
# this is a tk-like wrapper around my... class so that
# object creation works like other tk widgets
#
variable cnt; incr cnt
set obj [FindwidgetClass create tmp${cnt} $path {*}$args]
# rename oldName newName
rename $obj ::$path
return $path
}
oo::class create FindwidgetClass {
#
# This widget encapsulates the "Find in page..." functionality.
# Two tags may be added to the html widget(s):
# findwidget (all search hits)
# findwidgetcurrent (the current search hit)
#
constructor {path args} {
my variable hwidget
my variable win
my variable myNocaseVar
my variable myEntryVar
my variable myCaptionVar
my variable myCurrentHit
my variable myCurrentList
set myNocaseVar 1
set myEntryVar ""
set myCaptionVar ""
set myCurrentHit -1
set myCurrentList ""
# we use a frame for this specific widget class
set win [ttk::frame $path -class findwidget]
# we must rename the widget command
# since it clashes with the object being created
set widget ${path}_
rename $path $widget
ttk::entry $win.entry \
-width 30 \
-textvar "[namespace current]::myEntryVar"
ttk::label $win.label \
-text "Search"
ttk::checkbutton $win.check_nocase \
-text "Case Insensitive" \
-variable "[namespace current]::myNocaseVar"
# -style html3widget.TCheckbutton
ttk::label $win.num_results \
-textvar "[namespace current]::myCaptionVar"
ttk::button $win.close \
-text "Close" \
-style Toolbutton \
-command "[namespace code {my Escape}]"
trace add variable "[namespace current]::myEntryVar" write "[namespace code {my DynamicUpdate}]"
trace add variable "[namespace current]::myNocaseVar" write "[namespace code {my DynamicUpdate}]"
bind $win.entry <Return> "[namespace code {my Return}] 1"
bind $win.entry <Shift-Return> "[namespace code {my Return}] -1"
focus $win.entry
# Propagate events that occur in the entry widget to the
# ::html3widget::findwidget widget itself. This allows the calling script
# to bind events without knowing the internal mega-widget structure.
# For example, the html3widget app binds the <Escape> key to delete the
# findwidget widget.
#
bindtags $win.entry [concat [bindtags $win.entry] $win]
pack $win.entry $win.label -padx 4 -side left
pack $win.check_nocase -padx 4 -side left
pack $win.num_results -side left -fill x
pack $win.close -side right
}
destructor {
set w [namespace tail [self]]
catch {bind $w <Destroy> {}}
catch {destroy $w}
}
# no configuration, just member functions to get access tho the
# internal widget's (might be useful to configure imaces, etc.. later on)
method getlabelwidget {} {
my variable win
return $win.label
}
method getbuttonwidget {} {
my variable win
return $win.close
}
method register_htmlwidget {widget} {
my variable hwidget
set hwidget $widget
}
method register_closecommand {cmd} {
my variable win
$win.close configure -command \
"[namespace code {my Escape}]; $cmd"
}
method Escape {} {
my variable win
my variable myEntryVar
my variable myCaptionVar
# Delete any tags added to the html3widget widget.
# Do this inside a [catch] block, as it may be that
# the html3widget widget has itself already been destroyed.
#
foreach hwidget [my GetWidgetList] {
catch {
$hwidget tag delete findwidget
$hwidget tag delete findwidgetcurrent
}
}
trace remove variable "[namespace current]::myEntryVar" write "[namespace code {my UpdateDisplay}]"
trace remove variable "[namespace current]::myNocaseVar" write "[namespace code {my UpdateDisplay}]"
set myEntryVar ""
set myCaptionVar ""
}
method ComparePositionId {frame1 frame2} {
return [string compare [$frame1 positionid] [$frame2 positionid]]
}
method GetWidgetList {} {
my variable hwidget
return [list $hwidget]
}
method LazyMoveto {hwidget n1 i1 n2 i2} {
set nodebbox [$hwidget text bbox $n1 $i1 $n2 $i2]
set docbbox [$hwidget bbox]
set docheight "[lindex $docbbox 3].0"
set ntop [expr ([lindex $nodebbox 1].0 - 30.0) / $docheight]
set nbottom [expr ([lindex $nodebbox 3].0 + 30.0) / $docheight]
set sheight [expr [winfo height $hwidget].0 / $docheight]
set stop [lindex [$hwidget yview] 0]
set sbottom [expr $stop + $sheight]
if {$ntop < $stop} {
$hwidget yview moveto $ntop
} elseif {$nbottom > $sbottom} {
$hwidget yview moveto [expr $nbottom - $sheight]
}
}
# Dynamic update proc.
method UpdateDisplay {nMaxHighlight} {
my variable myNocaseVar
my variable myEntryVar
my variable myCaptionVar
my variable myCurrentList
set nMatch 0 ;# Total number of matches
set nHighlight 0 ;# Total number of highlighted matches
set matches [list]
# Get the list of html3widget widgets that (currently) make up this browser
# display. There is usually only 1, but may be more in the case of
# frameset documents.
#
set html3widgetlist [my GetWidgetList]
# Delete any instances of our two tags - "findwidget" and
# "findwidgetcurrent". Clear the caption.
#
foreach hwidget $html3widgetlist {
$hwidget tag delete findwidget
$hwidget tag delete findwidgetcurrent
}
set myCaptionVar ""
# Figure out what we're looking for. If there is nothing entered
# in the entry field, return early.
set searchtext $myEntryVar
if {$myNocaseVar} {
set searchtext [string tolower $searchtext]
}
if {[string length $searchtext] == 0} return
foreach hwidget $html3widgetlist {
set doctext [$hwidget text text]
if {$myNocaseVar} {
set doctext [string tolower $doctext]
}
set iFin 0
set lMatch [list]
while {[set iStart [string first $searchtext $doctext $iFin]] >= 0} {
set iFin [expr $iStart + [string length $searchtext]]
lappend lMatch $iStart $iFin
incr nMatch
if {$nMatch == $nMaxHighlight} { set nMatch "many" ; break }
}
set lMatch [lrange $lMatch 0 [expr ($nMaxHighlight - $nHighlight)*2 - 1]]
incr nHighlight [expr [llength $lMatch] / 2]
if {[llength $lMatch] > 0} {
lappend matches $hwidget [eval [concat $hwidget text index $lMatch]]
}
}
set myCaptionVar "(highlighted $nHighlight of $nMatch hits)"
foreach {hwidget matchlist} $matches {
foreach {n1 i1 n2 i2} $matchlist {
$hwidget tag add findwidget $n1 $i1 $n2 $i2
}
$hwidget tag configure findwidget -bg purple -fg white
my LazyMoveto $hwidget \
[lindex $matchlist 0] [lindex $matchlist 1] \
[lindex $matchlist 2] [lindex $matchlist 3]
}
set myCurrentList $matches
}
method DynamicUpdate {args} {
my variable myCurrentHit
set myCurrentHit -1
my UpdateDisplay 42
}
method Return {dir} {
my variable hwidget
my variable myCaptionVar
my variable myCurrentHit
my variable myCurrentList
set previousHit $myCurrentHit
if {$myCurrentHit < 0} {
my UpdateDisplay 100000
}
incr myCurrentHit $dir
set nTotalHit 0
foreach {hwidget matchlist} $myCurrentList {
incr nTotalHit [expr [llength $matchlist] / 4]
}
if {$myCurrentHit < 0 || $nTotalHit <= $myCurrentHit} {
# tk_messageBox \
# -parent $hwidget \
# -message "End of Search reached." \
# -type ok
if { $nTotalHit == 0 } {
set myCaptionVar "No search result."
} else {
set myCaptionVar \
"Hit $myCurrentHit / ${nTotalHit}, end of search reached."
}
incr myCurrentHit [expr -1 * $dir]
return
}
set myCaptionVar "Hit [expr $myCurrentHit + 1] / $nTotalHit"
set hwidget ""
foreach {hwidget n1 i1 n2 i2} [my GetHit $previousHit] { }
catch {$hwidget tag delete findwidgetcurrent}
set hwidget ""
foreach {hwidget n1 i1 n2 i2} [my GetHit $myCurrentHit] { }
my LazyMoveto $hwidget $n1 $i1 $n2 $i2
$hwidget tag add findwidgetcurrent $n1 $i1 $n2 $i2
$hwidget tag configure findwidgetcurrent -bg black -fg yellow
}
method GetHit {iIdx} {
my variable myCurrentList
set nSofar 0
foreach {hwidget matchlist} $myCurrentList {
set nThis [expr [llength $matchlist] / 4]
if {($nThis + $nSofar) > $iIdx} {
return [concat $hwidget [lrange $matchlist \
[expr ($iIdx-$nSofar)*4] [expr ($iIdx-$nSofar)*4+3]
]]
}
incr nSofar $nThis
}
return ""
}
}
}
Finally, here are the required images (ImageLib.tcl)
# ImageLib.tcl ---
# Automatically created by: CreateImageLib.tcl
set images(system-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==
}]
set images(dialog-close) [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==
}]