'''A [Snit] based wrapper for the [tkhtml] library''' ''[DDG] 13 Nov 2003'' This is slightly longer as a oneliner but it is inspired by code on [Simple Tkhtml web page displayer] (thx). A [Snit] wrapper widget created as a one afternoon hack. It's named snitBrowser because the TclPlugin contains already a package named browser! May be it is long but as a result the widget is fully reuseable. So easy is [Snit's Not Incr Tcl] ....: #!/usr/bin/tclsh ############################################################################## # # Copyright 2003 MPIMG Berlin, Germany. # All Rights Reserved # Created By : Dr. Detlef Groth nocatdgroth@molgen.mpg.de, nocatdetlef@dgroth.de # delete nocat to answer # Created : Mon Mar 10 16:41:10 2003 # Last Modified : <031114.0949> # # Description A simple htmlwidget providing the methods # load: popups a dialog for local file selection # browse: loads either a local file or a webpage # back, forward, home, Refresh: just like a normal browser behaves # popup : installs a popup with access to back, forward, home, refresh # SYNOPSIS # pack [snitbrowser .browser] -side left -fill both -expand yes # # WEB # .browser browse "http://mini.net/tcl/2993" # # LOCALFILES # .browser load # # installing the popup # .browser popup .popup # Notes # # History: V0.1 13/11/03: First Release a three hours hack # V0.2 14/11/03: Code Refactoring: # - Following William H. Duquette suggestions naming public methods # lowercase # - implementing public variables as options, like -showimages # - resorting loading of packages # - renaming LoadFile to the more appropiate `browse������´ method # - removing lonly global var popupvar # Bugs: - I would like to change some coderefs from self to mymethod as # suggested by William but this fails (try inside method home) # $Log: 10368,v $ # Revision 1.18 2005-06-22 06:00:25 jcw # 10368-1119377833-129.22.152.117 # # Revision 1.16 2005/01/23 07:00:45 jcw # 10368-1106460530-lwv,134.243.6.109 # # ############################################################################## # License: # Copyright (c) Dr. Detlef Groth, 2003 MPIMG Berlin, Germany. # # The authors hereby grant permission to use, copy, modify, distribute, # and license this software and its documentation for any purpose, # provided that existing copyright notices are retained in all copies and # that this notice is included verbatim in any distributions. No written # agreement, license, or royalty fee is required for any of the # authorized uses. Modifications to this software may be copyrighted by # their authors and need not follow the licensing terms described here, # provided that the new terms are clearly indicated on the first page of # each file where they apply. # # IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY # FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES # ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY # DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # # THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, # FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE # IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE # NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR # MODIFICATIONS. # # GOVERNMENT USE: If you are acquiring this software on behalf of the # U.S. government, the Government shall have only "Restricted Rights" # in the software and related documentation as defined in the Federal # Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you # are acquiring the software on behalf of the Department of Defense, the # software shall be classified as "Commercial Computer Software" and the # Government shall have only "Restricted Rights" as defined in Clause # 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the # authors grant the U.S. Government and others acting in its behalf # permission to use and distribute the software in accordance with the # terms specified in this license. ################################################################################ package provide snitbrowser 0.2 package require Tk package require http lappend auto_path [file dirname [info script]] package require snit 0.9 package require Tkhtml snit::widget snitbrowser { # methods starting with underlines/Uppercases are private # and should not be used externally variable htmlwidget variable lastDir variable Images variable OldImages variable hotkey variable LastFile variable PrevFiles variable NextFiles variable Priv variable Popupvar variable popup option -showimages 1 option -padx 5 option -pady 5 option -underlinehyperlinks 0 option -bg beige option -tablerelief raised delegate option * to htmlwidget delegate method * to htmlwidget constructor {args} { set lastDir [pwd] set LastFile {} set PrevFiles {} set NextFiles {} pack [frame $win.f] -side top -fill both -expand yes html $win.f.html \ -yscrollcommand "$win.f.vsb set" \ -xscrollcommand "$win.hsb set" \ -imagecommand [mymethod _ImageCmd] \ -formcommand [mymethod _FormCmd] \ -unvisitedcolor blue \ -bg $options(-bg) \ -underlinehyperlinks $options(-underlinehyperlinks) \ -pady $options(-pady) -padx $options(-padx) \ -tablerelief $options(-tablerelief) pack $win.f.html -side left -fill both -expand 1 scrollbar $win.f.vsb -orient vertical -command "$win.f.html yview" pack $win.f.vsb -side right -fill y bind $win.f.html.x <1> [mymethod _HrefBinding %x %y] bind $win.f.html.x [mymethod _SelectionBinding %W %x %y] scrollbar $win.hsb -orient horizontal -command "$win.f.html xview" pack $win.hsb -side bottom -fill x set htmlwidget $win.f.html image create photo smgray -data { R0lGODdhOAAYAPAAALi4uAAAACwAAAAAOAAYAAACI4SPqcvtD6OctNqLs968+w+G4kiW5omm 6sq27gvH8kzX9m0VADv/ } bind HtmlClip { set parent [winfo parent %W] set url [$parent href %x %y] if {[string length $url] > 0} { $parent configure -cursor hand2 } else { $parent configure -cursor {} } } $self configurelist $args } method home {} { $self browse [lindex $PrevFiles 0] } method back {} { $self browse [lindex $PrevFiles end] } method forward {} { $self browse [lindex $NextFiles end] } method _Popup {} { if {[winfo exists $Popupvar] } { set x [winfo pointerx .] set y [winfo pointery .] tk_popup $Popupvar $x $y } } method popup {path} { set Popupvar $path menu $Popupvar -tearoff 0 $Popupvar add command -label Refresh -underline 0 -accelerator Ctrl-r -command [mymethod refresh] $Popupvar add separator $Popupvar add command -label Home -accelerator Alt+Home -underline 1 -command [mymethod home] $Popupvar add command -label Back -accelerator Alt+Left -underline 1 -command [mymethod back] $Popupvar add command -label Forward -accelerator Alt+Right -underline 1 -command [mymethod forward] bind $htmlwidget.x [mymethod _Popup] bind all [ mymethod back ] bind all [ mymethod forward ] bind all [mymethod home] } method _FetchImage {src w h args} { # Fetch the image if {[catch { http::geturl $src -timeout 10000 } token]} { return smgray } set data [http::data $token] http::cleanup $token # Hack needed to make sure the data is binary: binary scan $data {} set name [image create photo] if {[catch {$name put $data} ret]} { return smgray } return $name } # anyone interested in implementing the _FormCmd ? method _FormCmd {args} { puts $args } method _ImageCmd {args} { if {!$options(-showimages)} { return smgray } set fn [lindex $args 0] if {[string match {http:*} $fn]} { set dat [$self _FetchImage $fn 1 1] return $dat } if {[info exists OldImages($fn)]} { set Images($fn) $OldImages($fn) unset OldImages($fn) return $Images($fn) } if {[catch {image create photo -file $fn} img]} { return $img(smgray) } if {[image width $img]*[image height $img]>20000} { set b [image create photo -width [image width $img] \ -height [image height $img]] set BigImages($b) $img set img $b after idle "MoveBigImage $b" } set Images($fn) $img return $img } method refresh {args} { if {![info exists LastFile]} return $self browse $LastFile } method _SelectionBinding {w x y} { $htmlwidget selection set @$Priv(mark) @$x,$y clipboard clear # avoid tkhtml0.0 errors # anyone can fix this for tkhtml0.0 catch { clipboard append [selection get] } } method _HrefBinding {x y} { set Priv(mark) $x,$y set list [$htmlwidget href $x $y] if {![llength $list]} {return} foreach {new target} $list break if {$new!=""} { set pattern $LastFile# set len [string length $pattern] incr len -1 if {[string range $new 0 $len]==$pattern} { incr len $htmlwidget yview [string range $new $len end] } else { $self browse $new } } } method _Clear {} { $htmlwidget clear catch {unset hotkey} $self _ClearBigImages $self _ClearOldImages foreach fn [array names Images] { set OldImages($fn) $Images($fn) } catch {unset Images} } method _ClearOldImages {} { foreach fn [array names OldImages] { image delete $OldImages($fn) } catch {unset OldImages} } method _ClearBigImages {} { foreach b [array names BigImages] { image delete $BigImages($b) } catch {unset BigImages} } method browse {name} { # dgroth fix if {$name eq ""} { return } # jcw 06/10/2000 - drop "#tag", if present set basename [lindex [split $name #] 0] set htmltxt [$self _ReadFile $basename] if {$htmltxt==""} return $self _Clear if {$name != $LastFile && $LastFile != ""} { if {$name == [lindex $PrevFiles end]} { set NextFiles [linsert $NextFiles 0 $LastFile] set PrevFiles [lreplace $PrevFiles end end] } else { lappend PrevFiles $LastFile if {$name == [lindex $NextFiles 0]} { set NextFiles [lrange $NextFiles 1 end] } else { set NextFiles {} } } } set LastFile $name $htmlwidget config -base $name # jcw 06/10/2000 - deal with text files (as suggested by Uwe Koloska) if {![regexp -nocase {|$htmltxt\n" } # jcw: end of changed code $htmlwidget parse $htmltxt $self _ClearOldImages # dgroth 13/11/2003 add jimping to internal name if {[regexp {(.+)#(.+)} $LastFile match file anchor]} { #tk_messageBox -title "Info!" -icon info -message "message jumping to $anchor" -type ok $htmlwidget yview $anchor } } method _ReadFile {name} { # dgroth fix for files containing anchors regexp {(.+)#} $name match name # fix for enabling web browsing if {[string match {http:*} $name]} { set t [http::geturl $name]; set r [http::data $t] http::cleanup $t; return $r } if {[catch {open $name r} fp]} { tk_messageBox -icon error -message $fp -type ok return {} } else { fconfigure $fp -translation binary set r [read $fp [file size $name]] close $fp return $r } } method load {} { set filetypes { {{Html Files} {.html .htm}} {{All Files} *} } set f [tk_getOpenFile -initialdir $lastDir -filetypes $filetypes] if {$f!=""} { $self browse $f set lastDir [file dirname $f] } } } proc lets_test_it {} { wm title . "Sample Snitbrowser by Dr. Detlef Groth, 2003" menu .menubar . config -menu .menubar set mnu(file) [menu .menubar.file -tearoff 0] .menubar add cascade -label File -underline 0 -menu $mnu(file) set mnu(help) [menu .menubar.help -tearoff 0] .menubar add cascade -label Help -underline 0 -menu $mnu(help) $mnu(help) add command -label "About ... " -underline 0 -command \ { tk_messageBox -title "About!" -icon info \ -message "Sample Snitbrowser by Dr. Detlef Groth\n\n 2003\n\n nocatdetlef@dgroth.de\n Delete nocat to answer!" -type ok} $mnu(file) add command -label Exit -underline 1 -command {exit 0} pack [snitbrowser .browser] -side left -fill both -expand yes #.browser browse d:/docs/tcl7.6/contents.html .browser browse "http://mini.net/tcl/snitbrowser" # installing the popup .browser popup .popup } lets_test_it ---- Where is MoveBigImage? ---- [male] - 2003-11-18: I've tried the source with ActiveTcl v8.4.4 on MS Windows 2000. If I click on a link, wish will crash with a read failure on address xyz. Did somebody make the same experience? Martin ---- Once the above code is verified as working, this seems like something that could be added to [tklib]. Of course, the extension won't do much without Tkhtml, right? ---- [DDG] I observe the same crash with ActiveTcl, however if using the correct cvs sources it works ok. So it seems to be a bug introduced by the ActiveTcl-version of tkhtml. Because this widget depends on tkhtml a c-library. It can't be included into [tklib] which hosts just tcl-only extensions. ---- '''2005-01-21''' I've used the snitbrowser as a starting point for my browser-widget. It's written in [[Incr]]Tcl and can be downloaded at [http://edugate.fss.uu.nl/~broeken/downloads/browser.itcl]. ---- [[ [Category Application] | [Category Internet] | [Category Snit Widgets] | [Tkhtml] | [Snit] ]]