'''[JOB] - 2017-01-23''' [WikiDBImage html3widget.png] [Larry Smith] I've been trying to understand this. I have an application which right now has a client that returns text that can be parsed for display by a tktext widget. Unfortunately, the tktext widget has no way to really store a document to disk, so I implemented a parallel system that would parse the markup commands and not only perform them in the text widget but also in html and save them to a log file that can be saved later as a .html file. This works, and takes care of things like bold, italic, and other such text effects - but I need to handle font changes and other things as well and I'm running into trouble trying to do it both ways compatibly. When I found the tkhtml referred to here my problem seemed solved. Replace the text widget and out html directly. Simple enough. But [https://www.tcl.tk/community/tcl2007/papers/Dan_Kennedy/file___localhost_...tcl2006_tkhtml3_tcl2006.pdf] seems to imply the capability of adding dynamic text is absent - or I can't figure out how to do it. Ideally, I should be able to take input in plaintext from an entry widget, ship it off to the server, get a burst of html in reply, and tack it on at the base of the html widget for display, providing a scroll and enabling me to save the whole thing in one go. Am I missing something here? The code seems o be using things like scrolledwidget, which seems not to be available from ActiveTcl, and adding it in to ActiveTcl results in a window that hangs when it tries to render. Very uninformative about where to even ''begin'' to look for the problem. Anybody have any ideas or pointers? /[Larry Smith] [JOB] @Larry: Just some short notes: The scrolledwidget is published on this wiki here: [A Scrolled Widget implemented with TclOO]. You can find the [HelpViewer - based on Tkhtml3.0], which is build ontop of Tkhtml 3.0 and html3widget, which can be downloaded from here: http://www.johann-oberdorfer.eu/blog/2017/04/10/17-10-04_helpviewer/ There is also an executable available, which should bring you to the point to render your html file (hopefully without a problem). As far as I understand, the html widget was not intended to be a replacement for the text widget. /[JOB] 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 has changed, it took me quite a while to figure out, how to render a page with Tkhtml3. In the meantime, I carried over some of the functionality from the hv3 browser (selection manager, integrated search+find widget). The complete package can be downloaded from here: http://www.johann-oberdorfer.eu/blog/2017/03/01/17-03-01_html3widget/ The [HelpViewer - based on Tkhtml3.0] is build on top of the html3widget. '''[APN] - 2017-03-02''' Looks very nice. Am going to take it for a spin to see if it can replace my Windows CHM file. Which Tkhtml3 distribution are you using? And do you happen to know the level of CSS support? '''[JOB] - 2017-03-02''' As stated in the HV3 homepage [http://tkhtml.tcl.tk/support.html]: * Tkhtml3 aims to support those aspects of '''HTML 4.01''' and '''CSS 2.1''' that apply to the parsing and visual rendering of documents. * I personally use the kit-enabled wish executables from the kbskit project (kbs.tcl), downloaded as binaries from sourceforge. You can find binaries for windows and OSX here. * The Tkhtml3.0 binary package I got from ActiveState - you need to use teacup as the standard installation of ActiveTcl includes only '''Tkhtml2.0''' by default. * Note: To avoid version conflicts '''package require -exact Tkhtml 3.0'''is required all the way long... * When searching the web for some modifications and improvements regarding the Tkhtml3.0 library, I discovered some patches here: ''tkhtml3-master-github''. Unfortunately I do not know right now, if these patches are already incorporated in the ActiveState distribution or not. * In other words: would be interesting to know, if ActiveState binaries are from ''tk-html3_3.0-fossil20110109.orig'' or maybe the one from: ''tkhtml3-master-github''? Source code (pls. also check out the link further up for the most recent package): * html3widget.tcl ====== # ----------------------------------------------------------------------------- # 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: # parseurl 'url' # parsefile html_file # examples: # set html3 [html3widget::html3widget .t] # pack $html3 # $html3 parseurl "http://wiki.tcl.tk/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 {}} 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 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 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 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 tags. # method Base_node_handler {node} { my variable html_baseurl # If a 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: # http://wiki.tcl.tk/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 \ "+[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 \ "[namespace code {my showhideSearchWidget}]" bind all \ "[namespace code {my showhideSearchWidget}]" set widgetCompounds(find_widget) $wfind # --------------------------- # eof findwidget declarations # --------------------------- bind all "[namespace code {my fontScaleCmd}] plus" bind all "[namespace code {my fontScaleCmd}] minus" # 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 # -------------------- # 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 { 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 { if {[winfo class %W] != "Html"} { return } set html_pointery [lindex [winfo pointerxy %W] 1] [winfo toplevel %W] configure -cursor "hand2" } bind all { if {[winfo class %W] != "Html"} { return } [winfo toplevel %W] configure -cursor "" } bind all { 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] } ====== ---- '''[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 # call this function to establisch communication # between findwidget and html3widget # # register_closecommand # 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 "[namespace code {my Return}] 1" bind $win.entry "[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 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 {}} 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== }] ====== ---- '''[JOB] - 2017-02-11''' * selectionmanager for the html3widget: ====== # ----------------------------------------------------------------------------- # 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 "+[namespace code {my MotionCmd}] {} %x %y" bind $hwidget "+[namespace code {my PressCmd}] {} %x %y" bind $hwidget "+[namespace code {my ReleaseCmd}] %x %y" bind $hwidget "+[namespace code {my DoublepressCmd}] %x %y" bind $hwidget "+[namespace code {my TriplepressCmd}] %x %y" bind all "[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 {} { } } ====== <> Category GUI | Category Object Orientation | Category Widget | Category HTML