Initial commit

1 files changed, 2089 insertions, 0 deletions

diff --git a/ds9/library/hvsup.tcl b/ds9/library/hvsup.tcl
new file mode 100644
index 0000000..c16545a
--- /dev/null
+++ b/ds9/library/hvsup.tcl
@@ -0,0 +1,2089 @@
+#  Copyright (C) 1999-2016
+#  Smithsonian Astrophysical Observatory, Cambridge, MA, USA
+#  For conditions of distribution and use, see copyright notice in "copyright"
+
+package provide DS9 1.0
+
+proc HVCancel {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVCancel"
+    }
+
+    # set state to 0 so that we don't process the finish proc
+    set var(active) 0
+
+    # stop any refresh
+    if {$var(refresh,id)>0} {
+	after cancel $var(refresh,id)
+	set var(refresh,id) 0
+    }
+
+    # analysis
+    if {$var(analysis)} {
+	AnalysisTaskEnd $var(analysis,which) $var(analysis,i)
+	HVSetAnalysis $varname 0 {} 0
+    }
+
+    # clean up
+    HVClearTmpFile $varname
+
+    if {[info exists var(token)]} {
+	http::reset $var(token)
+    }
+
+    if {[info exists var(widget)]} {
+	$var(widget) configure -cursor {}
+    }
+}
+
+proc HVDestroy {varname} {
+    upvar #0 $varname var
+    global $varname
+    global ihv
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVDestroy"
+    }
+
+    HVCancel $varname
+
+    # clear the widge and all images
+    $var(widget) clear
+
+    # clear image cache
+    foreach x [array names $varname "images,*"] {
+	image delete $var($x)
+	unset ${varname}($x)
+    }
+
+    # clear cache
+    HVClearCache $varname
+
+    # destroy the window and menubar
+    if {[winfo exists $var(top)]} {
+	destroy $var(top)
+	destroy $var(mb)
+    }
+
+    # delete it from the xpa list
+    set ii [lsearch $ihv(windows) $varname]
+    if {$ii>=0} {
+	set ihv(windows) [lreplace $ihv(windows) $ii $ii]
+    }
+
+    # clear varname
+    unset $varname
+}
+
+proc HVReset {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    set var(active) 0
+
+    if {[info exists var(token)]} {
+	global debug
+	if {$debug(tcl,hv)} {
+	    puts stderr "HVReset ***cleanup***"
+	}
+	http::cleanup $var(token)
+	unset var(token)
+    }
+}
+
+proc HVDone {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    HVStatus $varname {}
+    HVReset $varname
+}
+
+proc HVCancelled {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    HVStatus $varname {}
+    HVReset $varname
+}
+
+proc HVError {varname err} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVError $err"
+    }
+
+    HVReset $varname
+    Error $err
+}
+
+proc HVStatus {varname message} {
+    upvar #0 $varname var
+    global $varname
+
+    set var(status) $message
+}
+
+proc HVResolveURL {varname url} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    global pvo
+
+    if {$debug(tcl,hv)} {
+	puts stderr "HVResolveURL $varname $url"
+    }
+
+    set sync $var(sync)
+    # sub xpa method
+    set exp {%40%40XPA_METHOD%40%40|@@XPA_METHOD@@}
+    if {[regexp $exp $url]} {
+	regsub -all $exp $url [XPAMethod] url
+	if {$debug(tcl,hv)} {
+	    puts stderr "HVResolveURL XPA_METHOD $url"
+	}
+    }
+
+    # sub vo method
+    set exp {%40%40VO_METHOD%40%40|@@VO_METHOD@@}
+    if {[regexp $exp $url]} {
+	regsub -all $exp $url $pvo(method) url
+	if {$debug(tcl,hv)} {
+	    puts stderr "HVResolveURL VO_METHOD $url"
+	}
+    }
+
+    # if pvo(method) is xpa, HV has to be async
+    if {$pvo(method) == {xpa}} {
+	set sync 0
+    }
+
+    # some old sites have a problem with '?' in the query not encoded
+    ParseURL $url rr
+    if {$rr(query) != {}} {
+	if {[regsub -all {\?} $rr(query) {%25} query]} {
+	    set newurl "$rr(scheme)://$rr(authority)$rr(path)?$query"
+	    if {$rr(fragment) != {}} {
+		append newurl "#$rr(fragment)"
+	    }
+	    HVLoadURL $varname $newurl {} $sync
+	} else {
+	    HVLoadURL $varname $url {} $sync
+	}
+    } else {
+	HVLoadURL $varname $url {} $sync
+    }
+}
+
+# this is the main entry point, everybody calls here
+
+proc HVLoadURL {varname url query {sync 0}} {
+    upvar #0 $varname var
+    global $varname
+
+    # this assumes the url has been already resolved
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVLoadURL :$varname:$url:$query:$sync:"
+    }
+
+    # do we have anything?
+    if {$url == {}} {
+	return
+    }
+
+    HVStatus $varname {}
+
+    # parse url
+    ParseURL $url r
+    if {$debug(tcl,hv)} {
+	puts stderr "HVLoadURL |$r(scheme)|$r(authority)|$r(path)|$r(query)|$r(fragment)|$query|"
+    }
+
+    switch -- $r(scheme) {
+	file -
+	{} {HVProcessURLFile $varname $url $query r}
+	ftp {HVProcessURLFTP $varname $url $query r}
+	http {HVProcessURLHTTP $varname $url $query r $sync}
+	default {HVError $varname "[msgcat::mc {Sorry, DS9 does not support}] $r(scheme)"}
+    }
+}
+
+proc HVProcessURLFile {varname url query rr} {
+    upvar #0 $varname var
+    global $varname
+
+    upvar $rr r
+    
+    global ds9
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVProcessURLFile"
+    }
+
+    if {[file exists $r(path)]} {
+	if {[file isdirectory $r(path)]} {
+	    HVSetURL $varname $url {} {}
+	    HVSetResult $varname 200 "text/html"
+	    HVSetData $varname \
+		[HVFileHtmlList $r(path) [HVDirList $r(path)]] {}
+
+	    set var(delete) 0
+	    HVParse $varname
+	} else {
+	    HVSetURL $varname $url {} $r(fragment)
+	    set var(delete) 0
+	    HVLoadFile $varname $r(path)
+	}
+    }
+}
+
+proc HVProcessURLFTP {varname url query rr} {
+    upvar #0 $varname var
+    global $varname
+
+    upvar $rr r
+    
+    global ds9
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVProcessURLFTP"
+	DumpURL r
+    }
+
+    set fn [tmpnam [file extension $r(path)]]
+    set ftp [ftp::Open $r(authority) "ftp" "-ds9@" -mode passive]
+    if {$ftp > -1} {
+	# first try to get as file
+	set ftp::VERBOSE $debug(tcl,ftp)
+	set "ftp::ftp${ftp}(Output)" FTPLog
+	ftp::Type $ftp binary
+	if {[ftp::Get $ftp $r(path) "$fn"]} {
+	    ftp::Close $ftp
+
+	    if {$debug(tcl,hv)} {
+		puts stderr "HVProcessURLFTP get $fn"
+	    }
+	    HVSetURL $varname $url {} $r(fragment)
+
+	    set var(delete) 1
+	    HVLoadFile $varname "$fn"
+
+	    HVClearTmpFile $varname
+	} else {
+	    # from the prev attempt
+	    catch {file delete -force "$fn"}
+
+	    # is it a dir or file that could not be download?
+	    if {[file extension $r(path)] == {}} {
+
+		if {$debug(tcl,hv)} {
+		    puts stderr "HVProcessURLFTP list"
+		}
+
+		# now as a directory
+		set list [ftp::List $ftp $r(path)]
+		ftp::Close $ftp
+
+		HVSetURL $varname $url {} {}
+		HVSetResult $varname 200 "text/html"
+		HVSetData $varname [HVFTPHtmlList $r(authority) $r(path) $list] {}
+
+		set var(delete) 0
+		HVParse $varname
+	    } else {
+		HVError $varname "[msgcat::mc {Unable to open file}] $r(path)"
+		return
+	    }
+	}
+    }
+}
+
+proc HVProcessURLHTTP {varname url query rr sync} {
+    upvar #0 $varname var
+    global $varname
+
+    upvar $rr r
+    
+    global ds9
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVProcessURLHTTP"
+    }
+
+    # stop any refresh
+    if {[info exists ${varname}(refresh,id)]} {
+	if {$var(refresh,id)>0} {
+	    after cancel $var(refresh,id)
+	}
+    }
+
+    # do we already have it in cache?
+    if {[info exists ${varname}(cache,file,$url,$query)]} {
+
+	# has it expired?
+	if {($var(cache,expire,$url,$query) == 0) ||
+	    ($var(cache,expire,$url,$query) > [clock seconds])} {
+
+	    # just in case
+	    if {[file exists $var(cache,file,$url,$query)]} {
+		# ok, to it
+		if {$debug(tcl,hv)} {
+		    puts stderr "HVProcessURLHTTP found $url at $var(cache,file,$url,$query)"
+		}
+
+		HVSetURL $varname $url $query $r(fragment)
+		set var(delete) 0
+		HVSetResult $varname 200 $var(cache,mime,$url,$query)
+		HVSetData $varname {} $var(cache,file,$url,$query)
+
+		HVParse $varname
+
+		return
+	    }
+	}
+
+	# expired or invalid, clean up
+	if {$debug(tcl,hv)} {
+	    puts stderr "HVProcessURLHTTP expired or invalid $var(cache,file,$url,$query)"
+	}
+	catch {file delete $var(cache,file,$url,$query)}
+	unset var(cache,file,$url,$query)
+	unset var(cache,mime,$url,$query)
+	unset var(cache,expire,$url,$query)
+    }
+
+    HVSetURL $varname $url $query $r(fragment)
+    HVSetResult $varname {} {}
+    HVSetData $varname {} {}
+
+    set var(ch) {}
+
+    # do we have html? if so, use a var
+    ParseURL $url r
+
+    # geturl as file
+    set var(fn) [tmpnam {.http}]
+    if {[catch {open "$var(fn)" w} ${varname}(ch)]} {
+	HVError $varname "[msgcat::mc {Unable to open file}] $var(fn)"
+	return
+    }
+
+    # disable timeouts for analysis
+    global ihttp
+    set timeout $ihttp(timeout)
+    if {$var(analysis)} {
+	set timeout 0
+    }
+
+    if {$sync} {
+	if {![catch {set var(token) [http::geturl $url \
+					 -query "$query" \
+					 -timeout $timeout \
+					 -headers "[HVHTTPHeader $varname]" \
+					 -progress [list HVProgress $varname] \
+					 -binary 1 \
+					 -channel $var(ch)]
+	}]} {
+	    # reset errorInfo (may be set in http::geturl)
+	    global errorInfo
+	    set errorInfo {}
+
+	    set var(active) 1
+	    set var(delete) 1
+	    HVProcessURLHTTPFinish $varname $var(token)
+	} else {
+	    catch {close $var(ch)}
+	    HVError $varname "[msgcat::mc {Unable to locate URL}] $url"
+	}
+    } else {
+	if {![catch {set var(token) [http::geturl $url \
+					 -query "$query" \
+					 -timeout $timeout \
+					 -headers "[HVHTTPHeader $varname]" \
+					 -progress [list HVProgress $varname] \
+					 -binary 1 \
+					 -channel $var(ch) \
+					 -command [list HVProcessURLHTTPFinish $varname]]
+	}]} {
+	    # reset errorInfo (may be set in http::geturl)
+	    global errorInfo
+	    set errorInfo {}
+
+	    set var(active) 1
+	    set var(delete) 1
+	} else {
+	    catch {close $var(ch)}
+	    HVError $varname "[msgcat::mc {Unable to locate URL}] $url"
+	}
+    }
+}
+
+proc HVProcessURLHTTPFinish {varname token} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVProcessURLHTTPFinish"
+    }
+
+    catch {close $var(ch)}
+
+    if {!($var(active))} {
+	HVCancelled $varname
+	return
+    }
+
+    upvar #0 $token t
+
+    # Code
+    set var(code) [http::ncode $token]
+
+    # Meta
+    set var(meta) $t(meta)
+
+    # Cache defaults
+    set var(cache) 1
+    set var(cache,images) 1
+    set var(expire) 0
+
+    HVParseMeta $varname
+
+    # Log it
+    HTTPLog $token
+
+    # Result?
+    switch -- $var(code) {
+	200 -
+	203 -
+	404 -
+	503 {
+	    if {$var(cache)} {
+		if {$debug(tcl,hv)} {
+		    puts stderr "HVProcessURLHTTPFinish cacheing:$var(url),$var(query):$var(fn)"
+		}
+		set url $var(url)
+		set query $var(query)
+		set var(cache,file,$url,$query) $var(fn)
+		set var(cache,mime,$url,$query) $var(mime)
+		set var(cache,expire,$url,$query) $var(expire)
+		set var(delete) 0
+	    }
+	    HVParse $varname
+	    HVDone $varname
+	}
+
+	201 -
+	300 -
+	301 -
+	302 -
+	303 -
+	305 -
+	307 {
+	    foreach {name value} $var(meta) {
+		if {[regexp -nocase ^location$ $name]} {
+		    global debug
+		    if {$debug(tcl,hv)} {
+			puts stderr "HVProcessURLHTTPFinish redirect $var(code) to $value"
+		    }
+		    # clean up and resubmit
+		    http::cleanup $token
+		    unset var(token)
+
+		    HVClearTmpFile $varname
+
+		    if {[info exists var(widget)]} {
+			HVLoadURL $varname [$var(widget) resolve $value] {} $var(sync)
+		    } else {
+			HVLoadURL $varname $value {} $var(sync)
+		    }
+		}
+	    }
+	}
+
+	default {HVError $varname "HTTP [msgcat::mc {Error}] $var(code)"}
+    }
+}
+
+proc HVHTTPHeader {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    set domain {}
+    ParseURL $var(url) rr
+    regexp {[^:]*} $rr(authority) domain
+
+    set result "[ProxyHTTP]"
+    foreach cc $var(cookies) {
+	if {$domain == [lindex $cc 2]} {
+	    append result " Cookie [lindex $cc 0]=[lindex $cc 3]"
+	}
+    }
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVHTTPHeader:$result"
+    }
+
+    return $result
+}
+
+proc HVParseMeta {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVParseMeta: $var(meta)"
+    }
+
+    foreach {name value} $var(meta) {
+	switch -- [string tolower $name] {
+	    content-type {
+		regexp -nocase {([^;]*);?(.*)} $value foo \
+		    ${varname}(mime) ${varname}(mime,param)
+		set var(mime) [string tolower $var(mime)]
+	    }
+	    content-length {}
+	    content-encoding {
+		switch -- [string tolower $value] {
+		    gzip -
+		    x-gzip {set var(encoding) gzip}
+		    bzip2 {set var(encoding) bzip2}
+		    compress -
+		    Z {set var(encoding) compress}
+		    pack -
+		    z {set var(encoding) pack}
+		    default {}
+		}
+	    }
+	    content-transfer-encoding {
+		switch -- [string tolower $value] {
+		    binary -
+		    base64 {set var(transfer) [string tolower $value]}
+		    default {}
+		}
+	    }
+
+	    refresh {
+		set f [split $value \;]
+		set var(refresh,time) [lindex $f 0]
+		set var(refresh,url) [string range [lindex $f 1] 4 end]
+		if {$var(refresh,url) != {} & $var(refresh,time) != {}} {
+		    set var(refresh,id) [after [expr $var(refresh,time)*1000] "HVLoadURL $varname \{$var(refresh,url)\} {} $var(sync)"]
+		} else {
+		    set var(refresh,id) 0
+		}
+	    }
+	    expires {
+		if {[catch {set ss [clock scan $value]}]} {
+		    set var(cache) 0
+		} else {
+		    set var(cache) 1
+		    set var(expire) $ss
+		}
+	    }
+	    cache-control {
+		foreach cc [split $value {,}] {
+		    foreach {nn vv} [split $cc {=}] {
+			switch $nn {
+			    public {set var(cache) 1}
+			    private {set var(cache) 1}
+			    no-cache {set var(cache) 0}
+			    no-store {set var(cache) 1}
+
+			    s-maxage -
+			    min-fresh -
+			    max-age {
+				set var(cache) 1
+				set var(expire) \
+				    [expr [file mtime $var(fn)]+$vv]
+			    }
+			    max-stale {}
+			    no-transform {}
+			    only-if-cached {}
+			    cache-extension {}
+			    
+			    must-revalidate {}
+			    proxy-revalidate {}
+			}
+		    }
+		}
+	    }
+	    pragma {
+		switch $value {
+		    no-cache {set var(cache) 0}
+		}
+	    }
+	    last-modified {
+	    }
+	    if-none-match {
+	    }
+	    set-cookie {
+		set cname {}
+		set cpath {/}
+		set cdomain {}
+		set cvalue {}
+
+		ParseURL $var(url) rr
+		regexp {[^:]*} $rr(authority) cdomain
+
+		foreach cc [split $value {;}] {
+		    foreach {nn vv} [split $cc {=}] {
+			switch [string tolower [string trim $nn]] {
+			    httponly {}
+			    expires {}
+			    path {set cpath $vv}
+			    domain {set cdomain $vv}
+			    {} {append cvalue {=}}
+			    default {
+				if {$nn != {}} {
+				    set cname $nn
+				    set cvalue $vv
+				}
+			    }
+			}
+		    }
+		}
+		if {$cname != {}} {
+		    lappend ${varname}(cookies) [list $cname $cpath $cdomain $cvalue]
+		}
+	    }
+	}
+    }
+
+    if {$debug(tcl,hv)} {
+	puts stderr "HVParseMeta Content-Type:$var(mime):$var(mime,param):"
+	puts stderr "HVParseMeta Content-Encoding:$var(encoding):"
+	puts stderr "HVParseMeta Content-Transfer-Encoding:$var(transfer):"
+	puts stderr "HVParseMeta Refresh:$var(refresh,time):$var(refresh,url):"
+	puts stderr "HVParseMeta Cache:$var(cache)"
+	puts stderr "HVParseMeta Expires:$var(expire)"
+	puts stderr "HVParseMeta Cookies:$var(cookies)"
+    }
+}
+
+proc HVLoadFile {varname path} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVLoadFile $path"
+    }
+
+    HVSetResult $varname 200 {}
+    HVSetData $varname {} $path
+
+    # content-encoding
+    switch -- [string tolower [file extension $path]] {
+	.gz {
+	    set path [file rootname $path]
+	    set var(encoding) gzip
+	}
+	.bz2 {
+	    set path [file rootname $path]
+	    set var(encoding) bzip2
+	}
+	.Z {
+	    set path [file rootname $path]
+	    set var(encoding) compress
+	}
+	.z {
+	    set path [file rootname $path]
+	    set var(encoding) pack
+	}
+    }
+
+    switch -- [string tolower [file extension $path]] {
+	.html -
+	.htm {set var(mime) "text/html"}
+	.gif {set var(mime) "image/gif"}
+	.jpeg -
+	.jpg {set var(mime) "image/jpeg"}
+	.tiff -
+	.tif {set var(mime) "image/tiff"}
+	.png {set var(mime) "image/png"}
+
+	.fits -
+	.fit -
+	.fts {set var(mime) "image/fits"}
+
+	.ftz -
+	.fits.gz -
+	.fgz {
+	    set var(mime) "image/fits"
+	    set var(encoding) "gzip"
+	}
+
+	.text -
+	.txt {set var(mime) "text/plain"}
+	.multi {
+	    set var(mime) "multipart/mixed"
+	    set var(xpa,target) "*:*"
+	    if {[file exists "$path"]} {
+		set ch [open "$path" r]
+		if {[gets $ch line] >= 0} {
+		    set var(mime,param) "Content-Type: multipart/mixed; Boundary=[string range $line 2 end]"
+		}
+		catch {close $ch}
+	    }
+	}
+
+	.sao {set var(mime) "text/x-cmap-sao"}
+
+	default {
+	    switch -- $var(encoding) {
+		gzip -
+		bzip2 -
+		compress -
+		pack {set var(mime) "application/octet-stream"}
+		default {set var(mime) "text/plain"}
+	    }
+	}
+    }
+
+    HVParse $varname
+}
+
+proc HVParse {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVParse"
+    }
+
+    switch -- $var(mime) {
+	"multipart/alternative" -
+	"multipart/parallel" -
+	"multipart/digest" -
+	"multipart/related" -
+	"multipart/signed" -
+	"multipart/encrypted" -
+	"multipart/report" {}
+
+	"multipart/x-mixed-replace" -
+	"multipart/mixed" {
+	    HVParseMulti $varname
+	    HVClearCache $varname
+	}
+
+	default {HVParseSingle $varname}
+    }
+
+    if {$var(analysis)} {
+	AnalysisTaskEnd $var(analysis,which) $var(analysis,i)
+	HVSetAnalysis $varname 0 {} 0
+    }
+}
+
+proc HVParseMulti {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVParseMulti"
+    }
+
+    # do it now, to be restored later
+    if {[info exists var(index)]} {
+	incr ${varname}(index)
+	set var(index,$var(index)) [list $var(url) $var(query)]
+	set index $var(index)
+    }
+
+    set fn $var(fn)
+    set del $var(delete)
+
+    if {[file exists "$var(fn)"]} {
+	if {[catch {open "$var(fn)" r} ch]} {
+	    HVError $varname "[msgcat::mc {Unable to open file}] $var(fn)"
+	    return
+	}
+    }
+
+    set boundary [HVParseMimeParam $varname "boundary"]
+    if {[string equal "$boundary" {}]} {
+	HVError $varname [msgcat::mc {Invalid formated multipart/mixed mime type message}]
+	return
+    }
+
+    set state 1
+    set var(ch) {}
+
+    HVSetResult $varname 200 {}
+    HVSetData $varname {} {}
+
+    while {[gets $ch line] >= 0} {
+	if {$debug(tcl,hv)} {
+	    puts stderr "HVParseMulti $state:$line"
+	}
+
+	switch -- $state {
+	    1 {
+		# boundary
+		if {[string equal "--$boundary" $line]} {
+		    set state 2
+		}
+	    }
+	    2 {
+		# header
+		if {[string length $line] == 0} {
+		    HVParseMeta $varname
+
+		    # save to a file
+		    set var(fn) [tmpnam {.http}]
+		    set var(delete) 1
+		    if {[catch {open "$var(fn)" w} ${varname}(ch)]} {
+			HVError $varname "[msgcat::mc {Unable to open file}] $var(fn)"
+			return
+		    }
+		    switch $var(transfer) {
+			binary -
+			base64 {
+			    fconfigure $var(ch) \
+				-translation binary -encoding binary
+			}
+		    }
+
+		    set state 3
+		} else {
+		    if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} {
+			lappend var(meta) $key [string trim $value]
+		    }
+		}
+	    }
+	    3 {
+		# body
+		if {[string equal "--$boundary" $line]} {
+		    catch {close $var(ch)}
+		    HVParseSingle $varname
+		    HVClearTmpFile $varname
+
+		    set var(ch) {}
+
+		    HVSetResult $varname 200 {}
+
+		    # we want to preserve var(text)
+		    # HVSetData $varname {} {}
+		    set var(data) {}
+		    set var(fn) {}
+
+		    set state 2
+
+		} elseif {[string equal "--$boundary--" $line]} {
+		    catch {close $var(ch)}
+		    catch {close $ch}
+
+		    HVParseSingle $varname
+		    HVClearTmpFile $varname
+
+		    # reset file values
+		    set var(fn) $fn
+		    set var(delete) $del
+
+		    if {[info exists var(index)]} {
+			# reset index
+			set var(index) $index
+			HVClearIndex $varname $index
+		    }
+
+		    return
+
+		} else {
+		    switch $var(transfer) {
+			binary {puts -nonewline $var(ch) $line}
+			base64 {
+			    puts -nonewline $var(ch) [base64::decode $line]
+			}
+			default {puts $var(ch) $line}
+		    }
+		}
+	    }
+	}
+    }
+
+    # clean up
+    catch {close $ch}
+    set var(fn) $fn
+}
+
+proc HVParseSingle {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVParseSingle $var(url)"
+    }
+
+    switch -- $var(mime) {
+	"text/html" -
+	"text/plain" -
+	"application/octet-stream" {
+	    # its never fails, someone can't get there mime types correct. 
+	    # Override the mime type based on path
+
+	    ParseURL $var(url) r
+	    set path [file tail $r(path)]  
+
+	    # set content-encoding
+	    switch -- [file extension $path] {
+		.gz {
+		    set path [file rootname $path]
+		    set var(encoding) gzip
+		}
+		.bz2 {
+		    set path [file rootname $path]
+		    set var(encoding) bzip2
+		}
+		.Z {
+		    set path [file rootname $path]
+		    set var(encoding) compress
+		}
+		.z {
+		    set path [file rootname $path]
+		    set var(encoding) pack
+		}
+	    }
+
+	    # set Content-Type
+	    switch -- [file extension $path] {
+		.html -
+		.htm {set var(mime) "text/html"}
+		.gif {set var(mime) "image/gif"}
+		.jpeg -
+		.jpg {set var(mime) "image/jpeg"}
+		.tiff -
+		.tif {set var(mime) "image/tiff"}
+		.png {set var(mime) "image/png"}
+
+		.fits -
+		.fit -
+		.fts {set var(mime) "image/fits"}
+
+		.ftz -
+		.fgz {
+		    set var(mime) "image/fits"
+		    set var(encoding) "gzip"
+		}
+
+		.xml -
+		.vot -
+		.votable {set var(mime) "text/xml"}
+
+		.text -
+		.txt {set var(mime) "text/plain"}
+
+		.sao {set var(mime) "text/x-cmap-sao"}
+	    }
+	}
+    }
+
+    switch -- $var(mime) {
+	"text/html" {HVParseHTML $varname}
+	"text/plain" {HVParseText $varname}
+	"application/octet-stream" {HVParseSave $varname}
+
+	"image/gif" -
+	"image/jpeg" -
+	"image/tiff" -
+	"image/png" {HVParseImg $varname}
+
+	"image/fits" -
+	"application/fits" {HVParseFITS $varname}
+
+	"application/fits-image" -
+	"application/fits-table" -
+	"application/fits-group" {HVParseFITS $varname}
+
+	"image/x-fits" -
+	"binary/x-fits" -
+	"application/x-fits" {HVParseFITS $varname}
+
+	"image/fits-hcompress" -
+	"image/x-fits-h" {HVParseFITS $varname}
+
+	"image/x-gfits" -
+	"binary/x-gfits" -
+	"image/gz-fits" -
+	"application/x-gzip" -
+	"display/gz-fits" {
+	    set var(encoding) gzip
+	    HVParseFITS $varname
+	}
+
+	"image/bz2-fits" -
+	"display/bz2-fits" {
+	    set var(encoding) bzip2
+	    HVParseFITS $varname
+	}
+
+	"image/x-cfits" -
+	"binary/x-cfits" {
+	    set var(encoding) compress
+	    HVParseFITS $varname
+	}
+
+	"image/x-zfits" -
+	"binary/x-zfits" {
+	    set var(encoding) pack
+	    HVParseFITS $varname
+	}
+
+	"text/xml" -
+	"application/xml" -
+	"application/x-votable+xml" {HVParseVOT $varname}
+
+	"x-xpa/xpaget" {}
+	"x-xpa/xpaset" {HVParseXPASet $varname}
+	"x-xpa/xpainfo" {}
+	"x-xpa/xpaaccess" {}
+
+	"text/x-cmap-sao" {HVParseColormap $varname}
+
+	default {HVParseSave $varname}
+    }
+}
+
+proc HVParseText {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVParseText"
+    }
+
+    if {[string length $var(data)] == 0} {
+	if {[file exists "$var(fn)"]} {
+	    if {[catch {open "$var(fn)" r} ch]} {
+		HVError $varname "[msgcat::mc {Unable to open file}] $var(fn)"
+		return
+	    }
+	    set var(data) [read $ch]
+	    close $ch
+	}
+    }
+
+    if {$var(analysis)} {
+	if {$debug(tcl,hv)} {
+	    puts stderr "HVParseText Analysis"
+	}
+	AnalysisProcessGetURL $var(analysis,which) $var(analysis,i) $var(data)
+    } else {
+	append var(text) $var(data)
+	set var(data) \
+	    "<html>\n<body>\n$var(text)\n</body>\n</html>"
+	HVSetResult $varname 200 "text/html"
+	HVParseHTML $varname
+    }
+
+    HVClearCache $varname
+}
+
+proc HVParseHTML {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVParseHTML"
+    }
+
+    if {[string length $var(data)] == 0} {
+	if {[file exists "$var(fn)"]} {
+	    if {[catch {open "$var(fn)" r} ch]} {
+		HVError $varname "[msgcat::mc {Unable to open file}] $var(fn)"
+		return
+	    }
+	    set var(data) [read $ch]
+	    close $ch
+	}
+    }
+
+    # figure out the base
+    # we don't want any query or fragments
+    ParseURL $var(url) r
+
+    set base {}
+    # scheme
+    switch $r(scheme) {
+	http {append base "$r(scheme)://"}
+	ftp {}
+	file {}
+    }
+    # authority
+    if {[string length $r(authority)] != 0} {
+	append base "$r(authority)"
+    }
+    # path
+    if {[string length $r(path)] != 0} {
+	append base "$r(path)"
+    } else {
+	append base "/"
+    }
+    # query
+    if {[string length $r(query)] != 0} {
+	append base "?$r(query)"
+    }
+
+    # spaces?
+    # regsub { } $base {\ } base
+
+    $var(widget) config -base $base
+
+    if {$debug(tcl,hv)} {
+	DumpURL r
+	puts stderr "HVParseHTML base [$var(widget) cget -base]"
+    }
+
+    # we have a valid html
+    $var(widget) clear
+
+    # fix forms with no action
+    HVFixHTMLForm $varname
+
+    # and now, parse it
+    $var(widget) parse $var(data)
+
+    HVGotoHTML $varname
+}
+
+proc HVParseImg {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVParseImg $var(url)"
+    }
+
+    if {$var(save)} {
+	switch -- $var(mime) {
+	    "image/gif" {set fn [SaveFileDialog giffbox]}
+	    "image/jpeg" {set fn [SaveFileDialog jpegfbox]}
+	    "image/tiff" {set fn [SaveFileDialog tifffbox]}
+	    "image/png" {set fn [SaveFileDialog pngfbox]}
+	}
+	
+	if {[string length "$fn"] != 0} {
+	    if {![catch {file rename -force "$var(fn)" "$fn"}]} {
+		set var(fn) "$fn"
+		set var(delete) 0
+	    }
+	}
+    }
+
+    switch -- $var(frame) {
+	new {MultiLoadBase}
+	current {}
+    }
+
+    ImportPhotoFile $var(fn) {}
+
+    HVClearTmpFile $varname
+    HVClearAll $varname
+    HVUpdateDialog $varname
+}
+
+proc HVParseFITS {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    global ds9
+    global debug
+
+    if {$var(save)} {
+	switch -- $var(encoding) {
+	    gzip {FileLast savefitsfbox "ds9.fits.gz"}
+	    bzip2 {FileLast savefitsfbox "ds9.fits.bz2"}
+	    compress {FileLast savefitsfbox "ds9.fits.Z"}
+	    pack {FileLast savefitsfbox "ds9.fits.z"}
+	    default {FileLast savefitsfbox "ds9.fits"}
+	}
+
+	set fn [SaveFileDialog savefitsfbox]
+	if {[string length "$fn"] != 0} {
+	    if {![catch {file rename -force "$var(fn)" "$fn"}]} {
+		set var(fn) "$fn"
+		set var(delete) 0
+	    }
+	}
+    }
+
+    switch -- $var(frame) {
+	new {MultiLoadBase}
+	current {}
+    }
+
+    StartLoad
+    global loadParam
+    set loadParam(load,type) allocgz
+    set loadParam(load,layer) {}
+    set loadParam(file,type) fits
+    set loadParam(file,mode) {}
+    set loadParam(file,name) "$var(fn)"
+    set loadParam(file,fn) $loadParam(file,name)
+
+    # may have to convert the file, based on content-encoding
+    switch -- "$var(encoding)" {
+	bzip2 {
+	    catch {set ch [open "| bunzip2 < $var(fn) " r]}
+	    set loadParam(load,type) channel
+	    set loadParam(channel,name) $ch
+	}
+	compress {
+	    catch {set ch [open "| uncompress < $var(fn) " r]}
+	    set loadParam(load,type) channel
+	    set loadParam(channel,name) $ch
+	}
+	pack {
+	    catch {set ch [open "| pcat $var(fn) " r]}
+	    set loadParam(load,type) channel
+	    set loadParam(channel,name) $ch
+	}
+    }
+
+    ProcessLoad
+    FinishLoad
+
+    HVClearTmpFile $varname
+    HVClearAll $varname
+    HVUpdateDialog $varname
+}
+
+proc HVParseColormap {varname} {
+    upvar #0 $varname var
+    global $varname
+    global ds9
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVParseColormap"
+    }
+
+    set fn [HVParseMimeParam $varname "name"]
+    if {$fn == {}} {
+	ParseURL $var(url) r
+	set fn [file tail $r(path)]
+    }
+
+    if {![catch {file rename -force $var(fn) $ds9(tmpdir)/$fn}]} {
+	LoadColormapFile $ds9(tmpdir)/$fn
+    }
+
+    HVClearAll $varname
+    HVUpdateDialog $varname
+}
+
+proc HVParseVOT {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVParseVOT"
+    }
+
+    if {[file exists "$var(fn)"]} {
+	CATVOTFile "$var(fn)"
+    }
+
+    HVClearTmpFile $varname
+    HVClearAll $varname
+    HVUpdateDialog $varname
+}
+
+proc HVParseSave {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVParseSave"
+    }
+
+    set fn [HVParseMimeParam $varname "name"]
+    if {$fn == {}} {
+	ParseURL $var(url) r
+	set fn [file tail $r(path)]
+    }
+    FileLast savefitsfbox $fn
+    set fn [SaveFileDialog savefitsfbox]
+    if {[string length "$fn"] != 0} {
+	if {![catch {file rename -force "$var(fn)" "$fn"}]} {
+	    set var(delete) 0
+	}
+    }
+
+    HVClearAll $varname
+    HVUpdateDialog $varname
+}
+
+proc HVParseXPASet {varname} {
+    upvar #0 $varname var
+    global $varname
+    global ds9
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVParseXPASet: [HVParseMimeParam $varname paramlist]"
+    }
+
+    if {[info exists var(xpa,target)]} {
+	set target $var(xpa,target)
+    } else {
+	set target [HVParseMimeParam $varname target]
+    }
+
+    if {$target == "$ds9(title)" ||
+	$target == "DS9:*" ||
+	$target == "DS9:$ds9(title)" ||
+	$target == "*:$ds9(title)" ||
+	$target == "*:*" ||
+	$target == [XPAMethod]} {
+
+	InitError hv
+	CommSet $var(fn) [HVParseMimeParam $varname paramlist] 1
+    } else {
+	HVError $varname "[msgcat::mc {Unable to match target with XPA Mime request}] $url"
+    }
+}
+
+proc HVGotoHTML {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    incr ${varname}(index)
+    set var(index,$var(index)) [list $var(url) $var(query)]
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVGotoHTML $var(index) |$var(url)|$var(query)|$var(fragment)|"
+    }
+
+    if {[string length $var(fragment)] != 0} {
+	if {$debug(tcl,idletasks)} {
+	    puts stderr "HVGotoHTML"
+	}
+	update idletasks
+
+	$var(widget) yview $var(fragment)
+    } else {
+	$var(widget) yview moveto 0
+    }
+
+    HVUpdateDialog $varname
+}
+
+proc HVClearCache {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVClearCache $varname"
+    }
+
+    foreach x [array names $varname "cache,file,*"] {
+	catch {file delete $var($x)}
+    }
+    foreach x [array names $varname "cache,*"] {
+	unset ${varname}($x)
+    }
+}
+
+proc HVClearIndex {varname n} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVClearIndex $varname $n"
+    }
+
+    foreach x [array names $varname "index,*"] {
+	set f [split $x ,]
+	if {[lindex $f 1] > $n} {
+	    unset ${varname}($x)
+	}
+    }
+    set var(index) $n
+}
+
+proc HVClearTmpFile {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVClearTmpFile"
+    }
+
+    if {$var(delete) && [string length "$var(fn)"] != 0} {
+	if {[file exists "$var(fn)"]} {
+	    if {$debug(tcl,hv)} {
+		puts stderr "HVClearTmpFile delete $var(fn)"
+	    }
+	    file delete "$var(fn)"
+	}
+	set var(fn) {}
+	set var(delete) 0
+    }
+}
+
+proc HVUpdateDialog {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    # in case we've set the cursor
+    $var(widget) configure -cursor {}
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVUpdateDialog\n"
+    }
+
+    set id $var(index)
+    set id [incr id -1]
+    if {[info exists ${varname}(index,$id)]} {
+	$var(mb).view entryconfig [msgcat::mc {Back}] -state normal    
+    } else {
+	$var(mb).view entryconfig [msgcat::mc {Back}] -state disabled
+    }
+
+    set id $var(index)
+    set id [incr id 1]
+    if {[info exists ${varname}(index,$id)]} {
+	$var(mb).view entryconfig [msgcat::mc {Forward}] -state normal    
+    } else {
+	$var(mb).view entryconfig [msgcat::mc {Forward}] -state disabled
+    }
+}
+
+proc HVRefresh {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVRefresh"
+    }
+
+    set var(delete) 0
+    HVParse $varname
+}
+
+proc HVProgress {varname token totalsize currentsize} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVProgress:$varname"
+    }
+
+    if {$totalsize != 0} {
+	HVStatus $varname "$currentsize bytes of $totalsize bytes [expr int(double($currentsize)/$totalsize*100)]%"
+    } else {
+	HVStatus $varname "$currentsize bytes"
+    }
+}
+
+proc HVFTPHtmlList {host path list} {
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVFTPHtmlList $host $path"
+    }
+    if {[string range $path end end] != "/"} {
+	append path {/}
+    }
+
+    set html {}
+    append html "<html>\n"
+    append html "<head>\n"
+    append html "<title>Index of $path on $host</title>\n"
+    append html "</head>\n"
+    append html "<body>\n"
+    append html "<h1>Index on $path on $host</h1>\n"
+    append html "<hr>\n"
+    append html "<pre>\n"
+    foreach l $list {
+	switch -- [llength $l] {
+	    8 {set offset 4}
+	    9 {set offset 5}
+	    10 {set offset 4}
+	    11 {set offset 5}
+	    default {set offset 5}
+	}
+
+	set ii [lindex $l [expr $offset+3]]
+	switch -- [string range $l 0 0] {
+	    d {
+		set new "<a href=\"ftp://$host$path$ii/\">$ii</A>"
+	    }
+	    l {
+		set new "<a href=\"ftp://$host$path$ii\">$ii</A>"
+	    }
+	    default {
+		set new "<a href=\"ftp://$host$path$ii\">$ii</A>"
+	    }
+	}
+
+	regsub $ii $l $new l
+	append html "$l\n"
+    }
+    append html "</pre>\n"
+    append html "</hr>\n"
+    append html "</body>\n"
+
+    return $html
+}
+
+proc HVFileHtmlList {path list} {
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVFileHtmlList $path"
+    }
+
+    if {[string range $path end end] != "/"} {
+	append path {/}
+    }
+
+    set html {}
+    append html "<html>\n"
+    append html "<head>\n"
+    append html "<title>Index of $path</title>\n"
+    append html "</head>\n"
+    append html "<body>\n"
+    append html "<h1>Index on $path</h1>\n"
+    append html "<hr>\n"
+    append html "<pre>\n"
+    foreach l $list {
+	switch -- [llength $l] {
+	    8 {set offset 4}
+	    9 {set offset 5}
+	    10 {set offset 4}
+	    11 {set offset 5}
+	    default {set offset 5}
+	}
+
+	set ii [lindex $l [expr $offset+3]]
+	switch -- [string range $l 0 0] {
+	    d {
+		set new "<a href=\"file:$path$ii/\">$ii</A>"
+	    }
+	    l {
+		set new "<a href=\"file:$path$ii\">$ii</A>"
+	    }
+	    default {
+		set new "<a href=\"file:$path$ii\">$ii</A>"
+	    }
+	}
+
+	regsub $ii $l $new l
+	append html "$l\n"
+    }
+    append html "</pre>\n"
+    append html "</hr>\n"
+    append html "</body>\n"
+
+    return $html
+}
+
+proc HVDirList {path} {
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVDirList $path"
+    }
+    return [split [exec ls -l $path] \n]
+}
+
+proc HVSetURL {varname url query fragment} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVSetURL $url $query $fragment"
+    }
+
+    set var(url) $url
+    set var(query) $query
+    set var(fragment) $fragment
+}
+
+proc HVSetResult {varname code mime} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVSetResult $code $mime"
+    }
+
+    set var(code) $code
+    set var(meta) {}
+    set var(mime) $mime
+    set var(mime,param) {}
+    set var(cache) 0
+    set var(cache,images) 1
+    set var(expire) 0
+    set var(encoding) {}
+    set var(transfer) {}
+    set var(refresh,time) 0
+    set var(refresh,url) {}
+    set var(refresh,id) 0
+}
+
+proc HVSetData {varname data fn} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVSetData $fn"
+    }
+
+    set var(data) $data
+    set var(text) {}
+    set var(fn) "$fn"
+}
+
+proc HVSetAnalysis {varname aa which ii} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVSetAnalysis"
+    }
+
+    set var(analysis) $aa
+    set var(analysis,which) $which
+    set var(analysis,i) $ii
+}
+
+proc HVClearAll {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVClearAll"
+    }
+
+    HVSetURL $varname {} {} {}
+    HVSetResult $varname {} {}
+    HVSetData $varname {} {}
+    HVSetAnalysis $varname 0 {} 0
+}
+
+# CallBacks
+
+proc HVImageCB {varname args} {
+    upvar #0 $varname var
+    global $varname
+
+    global ds9
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVImageCB $varname args: $args"
+    }
+
+    set url [lindex $args 0]
+    if {$debug(tcl,hv)} {
+	puts stderr "HVImageCB url: $url"
+    }
+
+    # do we have anything?
+    if {[string length $url] == 0} {
+	return
+    }
+
+    # do we have a width/height?
+    set aa [lindex $args 3]
+    set width [HVattrs width $aa 0]
+    set height [HVattrs height $aa 0]
+    set src [HVattrs src $aa 0]
+
+    # check for percent (100%) in width/height
+    if {![string is integer $width]} {
+	set width 0
+    }
+    if {![string is integer $height]} {
+	set height 0
+    }
+
+    if {$debug(tcl,hv)} {
+	puts stderr "HVImageCB src: $width $height $src"
+    }
+
+    # we have a problem in that htmlwidget will not properly resolve a windows
+    # file name, there for we may have a bad file name url
+    # double check with the src attribute
+    global tcl_platform
+    switch $tcl_platform(platform) {
+	unix {}
+	windows {
+	    ParseURL $url r
+
+	    switch -- $r(scheme) {
+		{} -
+		file {
+		    if {![file exists $url]} {
+			# bad, try src
+			if {[file exists $src]} {
+			    set url $src
+			}
+		    }
+		}
+	    }
+	}
+    }
+
+    set img [HVImageURL $varname $url $width $height]
+
+    if {[string length $img] != 0} {
+	return $img
+    } else {
+	if {$debug(tcl,hv)} {
+	    puts stderr "HVImageCB FAIL $url"
+	}
+	return $var(images,gray)
+    }
+}
+
+proc HVImageURL {varname url width height} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVImageURL $varname $url $width $height"
+    }
+
+    # do we already have the image?
+    if {[info exists ${varname}(images,$url)]} {
+	if {$debug(tcl,hv)} {
+	    puts stderr "HVImageURL found image a $url"
+	}
+	return $var(images,$url)
+    }
+
+    ParseURL $url r
+
+    set fn {}
+    switch -- $r(scheme) {
+	{} -
+	file {
+	    if {[file exists $r(path)]} {
+		# can't use -file for zvfs
+		# catch {image create photo -file $r(path)} img
+		set ch [open $r(path) r]
+		fconfigure $ch -translation binary -encoding binary
+		set dd [read $ch]
+		close $ch
+		unset ch
+
+		catch {image create photo -data "$dd"} img
+		unset dd
+	    }
+	}
+	ftp {
+	    set fn [tmpnam [file extension $r(path)]]
+	    set ftp [ftp::Open $r(authority) "ftp" "-ds9@" -mode passive]
+	    if {$ftp > -1} {
+		set ftp::VERBOSE $debug(tcl,ftp)
+		set "ftp::ftp${ftp}(Output)" FTPLog
+		ftp::Type $ftp binary
+		if {[ftp::Get $ftp $r(path) "$fn"]} {
+		    ftp::Close $ftp
+
+		    if {[file size "$fn"] == 0} {
+			catch {file delete -force "$fn"}
+			return {}
+		    }
+		    if {[catch {image create photo -file "$fn"} img]} {
+			catch {file delete -force "$fn"}
+			return {}
+		    }
+		}
+	    }
+	}
+	http {
+	    set ch {}
+
+	    set fn [tmpnam [file extension $r(path)]]
+
+	    for {set ii 5} {$ii>0} {incr ii -1} {
+		if {[catch {open "$fn" w} ch]} {
+		    HVError $varname "[msgcat::mc {Unable to open file}] $fn"
+		    return {}
+		}
+
+		global ihttp
+		if {[catch {set token \
+			       [http::geturl $url \
+				    -timeout $ihttp(timeout) \
+				    -progress [list HVProgress $varname] \
+				    -channel $ch \
+				    -binary 1 \
+				    -headers "[HVHTTPHeader $varname]" \
+				   ]}]} {
+
+		    # if there is a problem, just bail
+		    set ii 0
+		    continue
+		}
+
+		# reset errorInfo (may be set in http::geturl)
+		global errorInfo
+		set errorInfo {}
+
+		catch {close $ch}
+
+		upvar #0 $token t
+		set code [http::ncode $token]
+		set meta $t(meta)
+
+		# result?
+		switch -- $code {
+		    200 -
+		    203 -
+		    503 {set ii 0}
+		
+		    201 -
+		    300 -
+		    301 -
+		    302 -
+		    303 -
+		    305 -
+		    307 {
+			foreach {name value} $meta {
+			    if {[regexp -nocase ^location$ $name]} {
+				global debug
+				if {$debug(tcl,hv)} {
+				    puts stderr "HVImageURL redirect $code to $value"
+				}
+				# clean up and resubmit
+				set url $value
+				http::cleanup $token
+				catch {file delete -force "$fn"}
+			    }
+			}
+		    }
+
+		    default {
+			# in general, we don't want to know about this
+			if {$debug(tcl,hv)} {
+			    puts stderr "HVImageURL HTTP Error: $code"
+			}
+			set ii 0
+		    }
+		}
+	    }
+
+	    catch {http::cleanup $token}
+
+	    if {[file size "$fn"] == 0} {
+		catch {file delete -force "$fn"}
+		return {}
+	    }
+	    if {[catch {image create photo -file "$fn"} img]} {
+		catch {file delete -force "$fn"}
+		return {}
+	    }
+	}
+    }
+
+    # do we have an img?
+    if {![info exists img]} {
+	return {}
+    }
+    if {$debug(tcl,hv)} {
+	puts stderr "HVImageURL got image $img"
+    }
+
+    # adjust image size if needed
+    if {$width != 0 || $height != 0} {
+	set iw [image width $img]
+	set ih [image height $img]
+
+	set doit 1
+	# check for one dimension of 0. calculate to maintain aspect ratio
+	if {$width == 0} {
+	    set width [expr $iw*$height/$ih]
+
+	    # see if we have a bad resample dimension
+	    set wf [expr double($iw)*$height/$ih]
+	    if {$width != $wf} {
+		if {$debug(tcl,hv)} {
+		    puts stderr "HVImageURL abort resample image $img width $wf"
+		}
+		set doit 0
+	    }
+	}
+	if {$height == 0} {
+	    set height [expr $ih*$width/$iw]
+
+	    # see if we have a bad resample dimension
+	    set hf [expr double($ih)*$width/$iw]
+	    if {$height != $hf} {
+		if {$debug(tcl,hv)} {
+		    puts stderr \
+			"HVImageURL abort resample image $img height $hf"
+		}
+		set doit 0
+	    }
+	}
+
+	# check to resample
+	if {$doit && ($width != $iw || $height != $ih)} {
+	    if {$debug(tcl,hv)} {
+		puts stderr "HVImageURL resample image $iw->$width $ih->$height"
+	    }
+
+	    set img2 \
+		[image create photo -width $width -height $height]
+	    if {[catch {blt::winop image resample $img $img2 box} ]} {
+		# just use existing img
+		if {$debug(tcl,hv)} {
+		    puts stderr "HVImageURL error resample image $img"
+		}
+	    } else {
+		set tmp $img
+		set img $img2
+		catch {image delete $tmp}
+	    }
+	}
+    }
+
+    # delete any tmp files
+    if {"$fn" != {}} {
+	catch {file delete -force "$fn"}
+    }
+
+    if {$var(cache,images)} {
+	set var(images,$url) $img
+    }
+
+    return $img
+}
+
+proc HVFontCB {varname sz args} {
+    upvar #0 $varname var
+    global $varname
+
+    global ds9
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVFontCB $varname $sz $args"
+    }
+
+    set family $var(font)
+    set size $var(font,size)
+    set weight $var(font,weight)
+    set slant $var(font,slant)
+
+    global ds9
+    foreach ff [concat [lindex $args 0]] {
+	switch -- $ff {
+	    fixed {
+		set family $ds9(courier)
+		set sz [expr $sz-1]
+	    }
+	    bold {set weight bold}
+	    italic {set slant italic}
+	}
+    }
+    
+    switch -- $sz {
+	0 {incr size -3}
+	1 {incr size -2}
+	2 {incr size -1}
+	3 {}
+	4 {incr size 6}
+	5 {incr size 12}
+	6 {incr size 24}
+	7 {incr size 36}
+    }
+
+    if {$debug(tcl,hv)} {
+	puts stderr "HVFontCB \{$family\} $size $weight $slant"
+    }
+    return "\{$family\} $size $weight $slant"
+}
+
+proc HVNoScriptCB {varname n tag args} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+#	puts stderr "HVNoScriptCB $varname $n $tag $args"
+    }
+}
+
+proc HVScriptCB {varname args} {
+    upvar #0 $varname var
+
+    global debug
+    if {$debug(tcl,hv)} {
+#	puts stderr "HVScriptCB $varname $args"
+    }
+}
+
+proc HVFrameCB {varname args} {
+    upvar #0 $varname var
+    global $varname
+
+    if {$debug(tcl,hv)} {
+	puts stderr "HVFrameCB $varname $args"
+    }
+}
+
+proc HVAppletCB {varname w args} {
+    upvar #0 $varname var
+    global $varname
+
+    global debug
+    if {$debug(tcl,hv)} {
+	puts stderr "HVAppletCB $varname $w $args"
+    }
+}
+
+proc HVParseMimeParam {varname key} {
+    upvar #0 $varname var
+    global $varname
+
+    foreach {pp} [split $var(mime,param) {;}] {
+	set id [string first {=} $pp]
+	set name [string trim [string range $pp 0 [expr $id-1]]]
+	set value [string trim [string range $pp [expr $id+1] end]]
+	if {[string equal -nocase $name $key]} {
+	    return [string trim $value {"'}]
+	}
+    }
+
+    return {}
+}