# -----------------------------------------------------------------------------
# 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 ...

# COMMANDS:
#   html3widget::html3widget path ?args?
#
# WIDGET-COMMANDS:
#         <widget> parseurl 'url'
#        <widget> parsefile html_file

# examples:
#   set html3 [html3widget::html3widget .t]
#        pack $html3
#         $html3 parseurl "https://wiki.tcl-lang.org/48458"
#        $html3 parsefile [file join $dir "demo_doc/tkhtml_doc.html"]
#



# for the moment, we keep required add-on packages
# down below *this* directory...

set dir [file normalize [file dirname [info script]]]
set auto_path [linsert $auto_path 0 [file join $dir "."]]


# in addition, these are the packages we essentially need:

package require Tk
package require -exact Tkhtml 3.0
package require scrolledwidget
package require selectionmanager
package require findwidget

# replace http package with native Tkhtml functionality:
catch {package require http}


package provide html3widget 0.2.1


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 html_basedir
                        my variable html_baseurl

                        my variable widgetOptions
                        my variable widgetCompounds
                        my variable isvisible
                        
                        # this goes together with the -zoom 1.0 option of the html widget
                        my variable current_scaleidx
                        my variable fontscales
                        
                        set html_basedir ""
                        set html_baseurl ""

                        set fontscales {0.6 0.8 0.9 1.0 1.2 1.4 2.0}
                        set current_scaleidx 3

                        set isvisible 0
                        
                        array set widgetCompounds {
                                dummy 0
                                selection_mgr ""
                        }

                        # 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
        }

        # this is only required to play togehter with helpviewer
        method setbasedir {basedir} {
                my variable html_basedir
                set html_basedir $basedir
        }
        
        method setsearchstring {search_str} {
                my variable widgetCompounds

                set wentry [$widgetCompounds(find_widget) getentrywidget]

                $wentry delete 0 end
                after idle "$wentry insert end $search_str"
        }
        
        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 parseurl {full_url} {
                my variable hwidget
                my variable html_baseurl

                # extract base url from url

                set b [::tkhtml::uri $full_url]
                # puts  "--> scheme: [$b scheme] authority: [$b authority]  path: [$b path]"

                # might be overwritten by the <base> handler - if there is a
                # custom declaration in the html's header section

                set html_baseurl "[$b scheme]://[$b authority]"

                set url [$b resolve $full_url]
                $b destroy
                
                set t [http::geturl $url]
                set data [http::data $t]
                        
                $hwidget reset
                $hwidget parse -final $data
                http::cleanup $t
        }

        
        # this procedure normally is triggered by
        # a <control-f> binding declaration

        method showhideSearchWidget {} {
                my variable hwidget
                my variable widgetCompounds
                my variable isvisible

                # retrieve the actual selection (if available)...
        
                if {$widgetCompounds(selection_mgr) != ""} {
                        set current_sel [string trim \
                                        [$widgetCompounds(selection_mgr) selected]]
                } else {
                        set current_sel ""
                }
                
                # mimik the n++ behaviour:
                # see, if there is a user selection available,
                # if yes, trigger the search with this value...

                set frm $widgetCompounds(searchframe)
                set wentry [$widgetCompounds(find_widget) getentrywidget]
                
                # 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
                        
                        $wentry delete 0 end
                        after idle "$wentry insert end $current_sel"
                                                
                } else {
                
                        # keep the search window on screen, just copy the selection
                        # into the etry widget and perform the search ...

                        if {$current_sel != "" } {
                                $wentry delete 0 end
                                after idle "$wentry insert end $current_sel"
                                return
                        }

                        $wentry delete 0 end
                        
                        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        }

                # clean search entry
                set wentry [$widgetCompounds(find_widget) getentrywidget]
                $wentry delete 0 end
                
                set isvisible 0
                pack forget $widgetCompounds(searchframe)
        }

        method fontScaleCmd {mode} {
                my variable hwidget
                my variable current_scaleidx
                my variable fontscales

                # set default value, if required
                if { ![info exists current_scaleidx] } {
                        $hwidget configure -fontscale  1.0
                        set current_scaleidx [lsearch $fontscales 1.0]
                }

                # zoom up/down acc. taking limits into account
                switch -- $mode {
                        "plus" {
                                set imax [expr { [llength $fontscales] -1 }]
                        
                                if {$current_scaleidx == $imax} {
                                        return
                                }
                                incr current_scaleidx
                        }
                        "minus" {
                                if {$current_scaleidx == 0} {
                                        return
                                }
                                incr current_scaleidx -1
                        }
                        "getscale" {
                                # returns the actual scale
                                return [lindex $fontscales $current_scaleidx]
                        }
                        default {
                                # unknown option, do nothing...
                                return {}
                        }
                }

                set current_scale [lindex $fontscales $current_scaleidx]
                
                # need some more information about this option (?):
                # $hwidget configure \
                #        -forcefontmetrics true \
                #        -fonttable [list 13 14 15 16 18 20 22]
                #
                $hwidget configure -fontscale $current_scale
                return $current_scale
        }

        method setscale {current_scale} {
                my variable hwidget
                my variable current_scaleidx
                my variable fontscales

                if {[set idx [lsearch $fontscales $current_scale]] != -1} {
                        set current_scaleidx $idx
                        $hwidget configure -fontscale $current_scale
                }
        }

        # This procedure is called when the user clicks on a hyperlink.
        #
        method hrefBinding {x y} {
                my variable hwidget
                my variable html_basedir
                
                if {$html_basedir == ""} { return }
        
                set node_data [$hwidget node -index $x $y]

                if { [llength $node_data] >= 2 } {
                        set node [lindex $node_data 0]
                } else {
                        set node $node_data
                }

                # parent node is an <A> tag (maybe?)
                if { [catch {set node [$node parent]} ] == 0 } {
        
                        if {[$node tag] == "a"} {
                                set href [string trim [$node attr -default "" href]]

                                if {$href ne "" && $href ne "#"} {
                                        set fname [file join $html_basedir $href]

                                        # follow the link, if the file exists
                                        if {[file exists $fname] } {
                                                my parsefile $fname
                                        }
                                }
                        }
                }
        }
        
        # Node handler script for <base> tags.
        #
        method Base_node_handler {node} {
                my variable html_baseurl

                # If a <base> tag is available in the main start page,
                # the default html_baseurl is overwritten by this node handler.
                # Might be the case for CMS generated pages.
                #
                set html_baseurl [$node attr -default "" href]
        }

        
        # Returns the full-uri formed by resolving $rel relative
        # to $base.
        #
        method Resolve_uri {base rel} {
                set b [::tkhtml::uri $base]
                # puts  "--> scheme: [$b scheme] authority: [$b authority]  path: [$b path]"
                
                set ret [$b resolve $rel]
                $b destroy
                set ret
        }

        # --------------------
        # Private Functions...
        # --------------------
        
        #  retrieve CSS "@import {...}" directives...

        method GetCSSImportTags {content} {
                set reflst {}
                foreach item [split $content ";"] {
                        # item might look like something like:
                        #   @import url("/_css/wikit.css")
                        #
                        if { [string first "@import" $item]  != -1 } {

                                set uri [string trim [lindex [split $item "\""] 1]]
                                if { $uri != "" } {
                                        lappend reflst $uri
                                }
                        }
                }
                return $reflst
        }
        
        method GetImageCmd {uri} {
                # see as well:
                #   https://wiki.tcl-lang.org/15586
                #
                my variable hwidget
                my variable html_basedir
                my variable html_baseurl

                if { $html_baseurl != ""} {
                        
                        # convert from relative to absolute 'url'
                        set uri [my Resolve_uri $html_baseurl $uri]

                        # if the 'url' is an http url.
                        if { [string equal -length 7 $uri "http://"] } {
                
                                if { [lsearch [image names] $uri] == -1 } {
                                
                                        set token [::http::geturl $uri]
                                        set data [::http::data $token]
                                        ::http::cleanup $token

                                        catch { image create photo $uri -data $data }
                                }
                                return $uri
                        }
                }

                if {$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
                        if { [file exists $uri]  && ![file isdirectory $uri] } {
                                # create image using file
                                image create photo $uri -file $uri
                                return $uri
                        } 
                
                        # create image using file
                        set fname [file join $html_basedir $uri]                

                        if { [file exists $fname]  && ![file isdirectory $fname] } {
                                image create photo $uri -file $fname
                        }
                        return $uri
                }

                return ""
        }
        
        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 html_baseurl
                my variable stylecount
                
                if { [string first "href" [$node attr]] == -1 } { return }
                
                set href [$node attr "href"]
                global "$href"

                if { ![info exists stylecount] } { set stylecount 0        }
                incr ::stylecount
                set id "author.[format %.4d $stylecount]"
                
                if {$html_baseurl != ""} {

                        # convert from relative to absolute 'url'
                        set href [my Resolve_uri $html_baseurl $href]
                        
                        # if the 'href' is an http url.
                        if { [string equal -length 7 $href http://] } {

                                set token [::http::geturl $href]
                                set href_content [::http::data $token]
                                ::http::cleanup $token

                                # console show; puts $href
                                # handle CSS "@import {...}" directives:
                                # as a 1st approach we just read in 1st level of @import

                                foreach import_ref [my GetCSSImportTags $href_content] {

                                        set importurl [my Resolve_uri $html_baseurl $import_ref]
                                        set importid "${id}.[format %.4d [incr ${stylecount}]]"

                                        set token [::http::geturl $importurl]
                                        set css_content [::http::data $token]
                                        ::http::cleanup $token

                                        $hwidget style -id $importid.9999 $css_content
                                }

                                $hwidget style -id $id.9999 $href_content
                        }
                }

                if {$html_basedir != ""} {

                        # use the full path name of the css reference
                        set fname [file join $html_basedir $href]        

                        if { [file exists $fname] && ![file isdirectory $fname] } {

                                set fp [open $fname "r"]
                                set href_content [read $fp]
                                close $fp

                                $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
                        }
                }
        }
        
        
        # Register for a callback when the end-user moves the pointer
        # over the HTML widget using the standard Tk bind command.
        #
        method RegisterDynamicEffectBindings {x y} {
                my variable hwidget
                
                # Clear the "hover" flag on all nodes
                # on which it is currently set.
                #
                foreach node [$hwidget search :hover] {
                        $node dynamic clear hover
                }

                [winfo parent $hwidget] configure -cursor {}
                
                # Set the hover flag on all nodes that generate content
                # at the specified coordinates, and all ancestors of said nodes.
                #
                foreach node [$hwidget node $x $y] {
                        for {} {$node != ""} {set node [$node parent]} {
                                # console show
                                #puts "--> $node : [$node attr]"
                                if { [string first "href" [$node attr]] != -1 } {
                                        [winfo parent $hwidget] configure -cursor hand2
                                }
                                catch { $node dynamic set hover }
                        }
                }
        }

        method Build {frm} {
                my variable widgetCompounds
                my variable hwidget
                my variable current_scaleidx

                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
                
                my setscale 1.0
                
                # register selection manager
                # (as a TclOO object, we instantiate the obj with "new")
                
                set widgetCompounds(selection_mgr) \
                                                                [selectionmanager new $hwidget]
                
                # register style sheet handler...
                # ** link base meta title style script body **

                $hwidget handler "node" "base" "[namespace code {my Base_node_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}]"

                # hlight + change cursor
                # when hovering with the mouse over a hypertext link
                bind $hwidget <Motion> \
                                "+[namespace code {my RegisterDynamicEffectBindings}] %x %y"

                # ---------------------------
                # 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) \
                        -compound left

                set wbutton [$wfind getsearchnextwidget]
                $wbutton configure \
                        -text "" \
                        -image $::html3widget::appImages(arrow-down) \
                        -compound left

                set wbutton [$wfind getsearchprevwidget]
                $wbutton configure \
                        -text "" \
                        -image $::html3widget::appImages(arrow-up) \
                        -compound left
                        
                        
                bind all <F3> \
                        "[namespace code {my showhideSearchWidget}]"
                bind all <Control-f> \
                        "[namespace code {my showhideSearchWidget}]"

                set widgetCompounds(find_widget) $wfind
                # ---------------------------
                # eof findwidget declarations
                # ---------------------------

                bind all <Control-plus> "[namespace code {my fontScaleCmd}] plus"
                bind all <Control-minus> "[namespace code {my fontScaleCmd}] minus"

                
                #  perhaps, makes the behavor of bindings more "reactive" ?
                tk_focusFollowsMouse
        }
}


# ---
# EOF
# ---

# 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


# --------------------
# 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

# --------
# bindings
# --------

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]
        }
}

# emulate scroll behavior when pressing the middle mouse button:
# cursor: sb_v_double_arrow / hand2

bind all <ButtonPress-2> {
        if {[winfo class %W] != "Html"} { return }
        set html_pointery [lindex [winfo pointerxy %W] 1]
        [winfo toplevel %W] configure -cursor "hand2"
}

bind all <ButtonRelease-2> {
        if {[winfo class %W] != "Html"} { return }
        [winfo toplevel %W] configure -cursor ""
}

bind all <B2-Motion> {
        if {[winfo class %W] != "Html"} { return }
        
        # (%D)irection is not supported for the Html widget class
        if { [lindex [winfo pointerxy %W] 1] > $html_pointery } {
                set D 1
        } else {
                set D -1
        }

        # we must make sure that positive and negative movements are rounded
        # equally to integers, avoiding the problem that
        #    (int)1/3 = 0, but (int)-1/3 = -1
        if {$D >= 0} {
                %W yview scroll [expr {-$D/3}] units
        } else {
                %W yview scroll [expr {(2-$D)/3}] units
        }
        
        set html_pointery [lindex [winfo pointerxy %W] 1]
}

# -----------------------------------------------------------------------------
# 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 no-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 ""
                }
        }
}

# 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==
}]

# -----------------------------------------------------------------------------
# selectionmanager
#
#     This type encapsulates the code that manages selecting text
#     in the html widget with the mouse.
#
# -----------------------------------------------------------------------------

package provide selectionmanager 0.1

oo::class create selectionmanager {
        
        constructor {hwidget} {
                my variable O
                
                # Variable myMode may take one of the following values:
                #
                #     "char"           -> Currently text selecting by character.
                #     "word"           -> Currently text selecting by word.
                #     "block"          -> Currently text selecting by block.
                #
                set O(myState) false             ;# True when left-button is held down
                set O(myMode) char
                
                set O(myHtml) $hwidget
                
                set O(myFromNode) ""
                set O(myFromIdx) ""

                set O(myToNode) ""
                set O(myToIdx) ""
                set O(myIgnoreMotion) 0
                                
                # (?) selection handle $hwidget "[namespace code {my get_selection}]"
                
                bind $hwidget <Motion>          "+[namespace code {my MotionCmd}] {} %x %y"
                bind $hwidget <ButtonPress-1>   "+[namespace code {my PressCmd}] {} %x %y"
                bind $hwidget <ButtonRelease-1> "+[namespace code {my ReleaseCmd}] %x %y"

                bind $hwidget <Double-ButtonPress-1> "+[namespace code {my DoublepressCmd}] %x %y"
                bind $hwidget <Triple-ButtonPress-1> "+[namespace code {my TriplepressCmd}] %x %y"
                
                bind all <Control-c> "[namespace code {my CopySelection2Clipboard}]"
        }
        
        # Clear the selection.
        #
        method ClearSelection {} {
                my variable O

                set O(myFromNode) ""
                set O(myToNode) ""
                
                $O(myHtml) tag delete selection
                $O(myHtml) tag configure selection -foreground white -background darkgrey
        }
        
        method PressCmd {N x y} {
                my variable O
                
                # Single click -> Select by character.
                my ClearSelection
                set O(myState) true
                set O(myMode) char
                my MotionCmd $N $x $y
        }
        
        # Given a node-handle/index pair identifying a character in the
        # current document, return the index values for the start and end
        # of the word containing the character.
        #
        method ToWord {node idx} {
                set t [$node text]
                set cidx [::tkhtml::charoffset $t $idx]
                set cidx1 [string wordstart $t $cidx]
                set cidx2 [string wordend $t $cidx]
                set idx1 [::tkhtml::byteoffset $t $cidx1]
                set idx2 [::tkhtml::byteoffset $t $cidx2]
                return [list $idx1 $idx2]
        }
        
        # Add the widget tag "selection" to the word containing the character
        # identified by the supplied node-handle/index pair.
        #
        method TagWord {node idx} {
                my variable O
                
                foreach {i1 i2} [my ToWord $node $idx] {}
                $O(myHtml) tag add selection $node $i1 $node $i2
        }
        
        # Remove the widget tag "selection" to the word containing the character
        # identified by the supplied node-handle/index pair.
        #
        method UntagWord {node idx} {
                my variable O
                
                foreach {i1 i2} [my ToWord $node $idx] {}
                $O(myHtml) tag remove selection $node $i1 $node $i2
        }
        
        method ToBlock {node idx} {
                my variable O
                set t [$O(myHtml) text text]
                set offset [$O(myHtml) text offset $node $idx]
                
                set start [string last "\n" $t $offset]
                if {$start < 0} {set start 0}
                set end   [string first "\n" $t $offset]
                if {$end < 0} {set end [string length $t]}
                
                set start_idx [$O(myHtml) text index $start]
                set end_idx   [$O(myHtml) text index $end]
                
                return [concat $start_idx $end_idx]
        }
        
        # method TagBlock {node idx} {
        #        my variable O
        #        
        #        foreach {n1 i1 n2 i2} [my ToBlock $node $idx] {}
        #        $O(myHtml) tag add selection $n1 $i1 $n2 $i2
        #}
        #method UntagBlock {node idx} {
        #        my variable O
        #        
        #        foreach {n1 i1 n2 i2} [my ToBlock $node $idx] {}
        #        catch {$O(myHtml) tag remove selection $n1 $i1 $n2 $i2}
        #}
        
        method DoublepressCmd {x y} {
                my variable O
                
                # Double click -> Select by word.
                my ClearSelection
                set O(myMode) word
                set O(myState) true
                my MotionCmd "" $x $y
        }
        
        method TriplepressCmd {x y} {
                my variable O
                
                # Triple click -> Select by block.
                my ClearSelection
                set O(myMode) block
                set O(myState) true
                my MotionCmd "" $x $y
        }
        
        method ReleaseCmd {x y} {
                my variable O

                set O(myState) false
        }
                
        method MotionCmd {N x y} {
                my variable O

                if {!$O(myState) || $O(myIgnoreMotion)} return
                
                set to [$O(myHtml) node -index $x $y]
                foreach {toNode toIdx} $to {}

                # $N containst the node-handle for the node that the cursor is
                # currently hovering over (according to the mousemanager component).
                # If $N is in a different stacking-context to the closest text,
                # do not update the highlighted region in this event.
                #
                if {$N ne "" && [info exists toNode]} {
                        if {[$N stacking] ne [$toNode stacking]} {
                                set to ""
                        }
                }
                
                if {[llength $to] > 0} {
                        
                        if {$O(myFromNode) eq ""} {
                                set O(myFromNode) $toNode
                                set O(myFromIdx) $toIdx
                        }
                        
                        # This block is where the "selection" tag is added to the HTML
                        # widget (so that the selected text is highlighted). If some
                        # javascript has been messing with the tree, then either or
                        # both of $myFromNode and $myToNode may be orphaned or deleted.
                        # If so, catch the exception and clear the selection.
                        #
                        set rc [catch {
                                if {$O(myToNode) ne $toNode || $toIdx != $O(myToIdx)} {
                                        switch -- $O(myMode) {
                                                char {
                                                        if {$O(myToNode) ne ""} {
                                                                $O(myHtml) tag remove selection $O(myToNode) $O(myToIdx) $toNode $toIdx
                                                        }
                                                        $O(myHtml) tag add selection $O(myFromNode) $O(myFromIdx) $toNode $toIdx
                                                        if {$O(myFromNode) ne $toNode || $O(myFromIdx) != $toIdx} {
                                                                selection own $O(myHtml)
                                                        }
                                                }
                                                
                                                word {

                                                        if {$O(myToNode) ne ""} {
                                                                $O(myHtml) tag remove selection $O(myToNode) $O(myToIdx) $toNode $toIdx
                                                                my UntagWord $O(myToNode) $O(myToIdx)
                                                        }
                                                        
                                                        $O(myHtml) tag add selection $O(myFromNode) $O(myFromIdx) $toNode $toIdx
                                                        # my TagWord $toNode $toIdx
                                                        my TagWord $O(myFromNode) $O(myFromIdx)
                                                        selection own $O(myHtml)
                                                }
                                                
                                                block {
                                                        set to_block2  [my ToBlock $toNode $toIdx]
                                                        set from_block [my ToBlock $O(myFromNode) $O(myFromIdx)]
                                                        
                                                        if {$O(myToNode) ne ""} {
                                                                set to_block [my ToBlock $O(myToNode) $O(myToIdx)]
                                                                $O(myHtml) tag remove selection $O(myToNode) $O(myToIdx) $toNode $toIdx
                                                                eval $O(myHtml) tag remove selection $to_block
                                                        }
                                                        
                                                        $O(myHtml) tag add selection $O(myFromNode) $O(myFromIdx) $toNode $toIdx
                                                        eval $O(myHtml) tag add selection $to_block2
                                                        eval $O(myHtml) tag add selection $from_block
                                                        selection own $O(myHtml)
                                                }
                                        }
                                        
                                        set O(myToNode) $toNode
                                        set O(myToIdx) $toIdx
                                }
                        } msg]
                        
                        if {$rc && [regexp {[^ ]+ is an orphan} $msg]} {
                                my ClearSelection
                        }
                }
                
                set motioncmd ""
                set win $O(myHtml)
                if {$y > [winfo height $win]} {
                        set motioncmd [list yview scroll 1 units]
                } elseif {$y < 0} {
                        set motioncmd [list yview scroll -1 units]
                } elseif {$x > [winfo width $win]} {
                        set motioncmd [list xview scroll 1 units]
                } elseif {$x < 0} {
                        set motioncmd [list xview scroll -1 units]
                }
                
                if {$motioncmd ne ""} {
                        set O(myIgnoreMotion) 1
                        eval $O(myHtml) $motioncmd
                        after 20 "[namespace code {my ContinueMotion}]"
                }
        }
        
        method ContinueMotion {} {
                my variable O
                
                set win $O(myHtml)
                set O(myIgnoreMotion) 0
                set x [expr [winfo pointerx $win] - [winfo rootx $win]]
                set y [expr [winfo pointery $win] - [winfo rooty $win]]
                set N [lindex [$O(myHtml) node $x $y] 0]
                my MotionCmd $N $x $y
        }

        method CopySelection2Clipboard {} {
                clipboard clear
                clipboard append [my selected]
        }
        
        # get_selection OFFSET MAXCHARS
        #
        #     This command is invoked whenever the current selection is selected
        #     while it is owned by the html widget. The text of the selected
        #     region is returned.
        #
        method get_selection {offset maxChars} {
                my variable O
                
                set t [$O(myHtml) text text]
                
                set n1 $O(myFromNode)
                set i1 $O(myFromIdx)
                set n2 $O(myToNode)
                set i2 $O(myToIdx)
                
                set stridx_a [$O(myHtml) text offset $O(myFromNode) $O(myFromIdx)]
                set stridx_b [$O(myHtml) text offset $O(myToNode) $O(myToIdx)]
                if {$stridx_a > $stridx_b} {
                        foreach {stridx_a stridx_b} [list $stridx_b $stridx_a] {}
                }
                
                if {$O(myMode) eq "word"} {
                        set stridx_a [string wordstart $t $stridx_a]
                        set stridx_b [string wordend $t $stridx_b]
                }
                if {$O(myMode) eq "block"} {
                        set stridx_a [string last "\n" $t $stridx_a]
                        if {$stridx_a < 0} {set stridx_a 0}
                        set stridx_b [string first "\n" $t $stridx_b]
                        if {$stridx_b < 0} {set stridx_b [string length $t]}
                }
                
                set T [string range $t $stridx_a [expr $stridx_b - 1]]
                set T [string range $T $offset [expr $offset + $maxChars]]
                
                return $T
        }
        
        method selected {} {
                my variable O
                
                if {$O(myFromNode) eq ""} {return ""}
                return [my get_selection 0 10000000]
        }
        
        method destroy {} {
        }
}