# # Test script for the Tk HTML widget # wm withdraw . if {[lsearch [namespace children] ::tcltest] == -1} { source [file dirname $argv0]/engine.tcl namespace import ::tcltest::* cd [file dirname $argv0] } # in image to use for all GIFs. # image create photo nogifsm -data { R0lGODdhEAAQAPEAAACQkADQ0PgAAAAAACwAAAAAEAAQAAACNISPacHtD4IQz80QJ60as25d 3idKZdR0IIOm2ta0Lhw/Lz2S1JqvK8ozbTKlEIVYceWSjwIAO/// } # A callback to handle image requests # proc ImageCmd {args} { set fn [lindex $args 0] if {[catch {image create photo -file $fn} img]} { set img nogifsm } return $img } # Free all images # proc FreeImages {} { foreach img [image names] { image delete $img } } # Create the HTML widget to use for all testing. # set h [tkhtml_test_widget] $h config -imagecommand ImageCmd ::tcltest::test html-2.1 { A snapshot of Slashdot on Jan 29, 2000. } { set file page1/index.html $h clear set f [open $file r] $h config -base $file $h parse [read $f [file size $file]] close $f set r [::tcltest::user-result] $h clear FreeImages return $r } {2 pass} ::tcltest::test html-2.2 { A snapshot of a page from the Scriptics website on Jan 29, 2000. } { set file page2/index.html $h clear set f [open $file r] $h config -base $file $h parse [read $f [file size $file]] close $f set r [::tcltest::user-result] $h clear FreeImages return $r } {2 pass} ::tcltest::test html-2.3 { A snapshot of freshmeat on Jan 29, 2000 } { set file page4/index.html $h clear set f [open $file r] $h config -base $file $h parse [read $f [file size $file]] close $f set r [::tcltest::user-result] $h clear FreeImages return $r } {2 pass} ::tcltest::test html-2.4 { A slide show about mktclapp } { set file page3/index.html $h clear set f [open $file r] $h config -base $file $h parse [read $f [file size $file]] close $f set r [::tcltest::user-result] $h clear FreeImages return $r } {2 pass}