saods9-data 7.2+dfsg-4 / usr / share / saods9 / src / util.tcl

#  Copyright (C) 1999-2012
#  Smithsonian Astrophysical Observatory, Cambridge, MA, USA
#  For conditions of distribution and use, see copyright notice in "copyright"

package provide DS9 1.0

proc CurrentDef {} {
    global current
    global pcurrent
    global ds9

    set current(frame) {}
    set current(ext) {}
    set current(colorbar) {}
    set current(cursor) {}
    set current(rgb) red

    set current(display) single
    set current(mode) pointer
    set current(zoom) { 1 1 }
    set current(rotate) 0
    set current(orient) none
    set current(align) 0

    set pcurrent(display) $current(display)
    set pcurrent(mode) $current(mode)
    set pcurrent(zoom) $current(zoom)
    set pcurrent(rotate) $current(rotate)
    set pcurrent(orient) $current(orient)
    set pcurrent(align) $current(align)
}

proc CursorDef {} {
    global icursor

    set icursor(save) {}
    set icursor(count) 0
    set icursor(id) 0
    set icursor(timer) 0
    set icursor(timer,abort) 0
}

proc UpdateDS9Static {} {
    # This routine is only called when an frame is added or deleted
    # we only change menu items which require at least one frame

    global debug
    if {$debug(tcl,update)} {
 	puts stderr "UpdateDS9Static begin..."
    }

    UpdateFileMenuStatic
    UpdateFrameMenuStatic
    UpdateZoomMenuStatic
    UpdateAnalysisMenuStatic
    
    if {$debug(tcl,update)} {
 	puts stderr "UpdateDS9Static end...\n"
    }
}

proc UpdateDS9 {} {
    global ds9
    global current

    # This routine is called when ever there is a state change within ds9
    # for example, a image is loaded, current(frame) is changed, etc

    global debug
    if {$debug(tcl,update)} {
	puts stderr "UpdateDS9 begin..."
    }

    UpdateFileMenu
    UpdateEditMenu
    UpdateFrameMenu
    UpdateBinMenu
    UpdateZoomMenu
    UpdateScaleMenu
    UpdateColorMenu
    UpdateRegionMenu
    # wcs(system) set here
    UpdateWCSMenu 
    UpdateAnalysisMenu

    UpdateMaskMenu
    UpdateContourMenu
    UpdateGridMenu
    UpdateSmoothMenu
    UpdateCubeMenu
    UpdateRGBMenu
    UpdatePanZoomMenu

    UpdateBinDialog
    UpdatePanZoomDialog
    UpdateCropDialog
    UpdateScaleDialog
    UpdateColorDialog
    UpdateWCSDialog

    UpdateGroupDialog
    UpdateCATDialog
    UpdateCentroidDialog
    UpdateCubeDialog
    UpdateRGBDialog
    Update3DDialog
    UpdateContourDialog
    UpdateGridDialog

    UpdateGraphXAxis $current(frame)
    UpdateGraphYAxis $current(frame)

    RefreshInfoBox $current(frame)
    UpdateColormapLevel
    
    if {$debug(tcl,update)} {
	puts stderr "UpdateDS9 end...\n"
    }
}

# changes to other dialogs can affect the infobox and pixeltable
proc UpdateMain {} {
    global current

    global debug
    if {$debug(tcl,update)} {
	puts stderr "UpdateMain"
    }

    RefreshInfoBox $current(frame)
    UpdateColormapLevel
    switch -- $current(mode) {
	crosshair {
	    if {$current(frame) != {}} {
		set coord [$current(frame) get crosshair canvas]
		set x [lindex $coord 0]
		set y [lindex $coord 1]

		# just in case we hae a mosaic
		UpdateColormapLevelMosaic $current(frame) $x $y canvas
		UpdatePixelTableDialog $current(frame) $x $y canvas
		UpdateGraph $current(frame) $x $y canvas
	    }
	}
	none -
	pointer -
	catalog -
	colorbar -
	pan -
	zoom -
	rotate -
	crop -
	examine -
	imexam {}
    }
}

proc ProcessSend {proc id sock fn ext rr} {
    if {$sock != {}} {
	# not implemented
    } elseif {$fn != {}} {
	append fn $ext
	set ch [open $fn w]
	puts $ch $rr
	close $ch
	$proc $id {} $fn
    } else {
	$proc $id $rr
    }
}

proc Toplevel {w mb style title proc} {
    global ds9

    toplevel $w
    switch $ds9(wm) {
	x11 -
	win32 {}
	aqua {
	    switch $style {
		6 {::tk::unsupported::MacWindowStyle style $w document "closeBox collapseBox"}
		7 {::tk::unsupported::MacWindowStyle style $w document "closeBox fullZoom collapseBox resizable"}
	    }
	    bind $w <$ds9(ctrl)-`> "lower $w"
	}
    }

    wm title $w $title
    wm iconname $w $title
    wm group $w $ds9(top)
    wm protocol $w WM_DELETE_WINDOW $proc

    $w configure -menu $mb
    menu $mb
    AppleMainMenu $mb

    global pds9
    if {$pds9(dialog,center)} {
	DialogCenter $w
    }
}

proc GetFileURL {url fname} {
    upvar $fname fn

    ParseURL $url rr
    switch -- $rr(scheme) {
	ftp {GetFileFTP $rr(authority) $rr(path) $fn}
	file {set fn $rr(path)}
	http -
	default {GetFileHTTP $url $fn}
    }
}

proc GetFileFTP {host path fn} {
    global debug

    set ftp [ftp::Open $host {ftp} {-ds9@} -mode passive]
    if {$ftp > -1} {
	set ftp::VERBOSE $debug(tcl,ftp)
	set "ftp::ftp${ftp}(Output)" FTPLog
	ftp::Type $ftp binary
	ftp::Get $ftp $path $fn
	ftp::Close $ftp

	# clear error from tcllib ftp
	global errorInfo
	set errorInfo {}
    }
}

proc GetFileHTTP {url fn} {
    global ihttp

    set ch [open $fn w]
    if [catch {http::geturl $url \
		   -protocol 1.0 \
		   -timeout $ihttp(timeout) \
		   -channel $ch \
		   -binary 1 \
		   -headers "[ProxyHTTP]"} token] {
	close $ch
	return
    }

    # reset errorInfo (may be set in http::geturl)
    global errorInfo
    set errorInfo {}

    close $ch
    if {[info exists token]} {
	HTTPLog $token
	http::cleanup $token
    }
}

proc SourceInitFile {ext} {
    global ds9
    global env
    
    foreach ff {{.} {}} {
	set fn $ff$ds9(app)$ext
	foreach dir [list {.} [GetEnvHome] {/usr/local/lib} {/opt/local/lib}] {
	    set ff [file join $dir $fn]
	    if [file exist $ff] {
		# can't make this a debug command line option
		# prefs set before options parsed
		if [catch {source $ff}] {
		    Error "[msgcat::mc {An error has occured while executing}] $ff. [msgcat::mc {DS9 will complete the initialization process}]"
		    return 0
		}
		return 1
	    }
	}
    }

    return 0
}

proc DeleteInitFile {ext} {
    global ds9
    global env
    
    foreach ff {{.} {}} {
	set fn $ff$ds9(app)$ext
	foreach dir [list {.} [GetEnvHome]] {
	    set ff [file join $dir $fn]
	    if [file exist $ff] {
		catch {file delete -force $ff}
		return
	    }
	}
    }
}

proc LanguageToName {which} {
    switch $which {
	locale {return {Locale}}
	cs {return "\u010Cesky"}
	da {return {Dansk}}
	de {return {Deutsch}}
	en {return {English}}
	es {return {Español}}
	fr {return {Français}}
	ja {return [encoding convertfrom euc-jp "\xc6\xfc\xcb\xdc\xb8\xec"]}
	pt {return {Português}}
	zh {return [encoding convertfrom big5 "\xA4\xA4\xA4\xE5"]}
    }
}

proc SetLanguage {ll} {
    global ds9
    global pds9
    
    set pds9(language,name) [LanguageToName $ll]

    set x 0
    msgcat::mclocale $ll

    msgcat::mcload [file join $::tk_library msgs]

    # we need to find if we support this language
    if [msgcat::mcload [file join $ds9(root) msgs]] {
	incr x
    }
    if {$pds9(language,dir) != {}} {
	if [msgcat::mcload $pds9(language,dir)] {
	    incr x
	}
    }

    # if english, always return found
    if {[string equal [string range $ll 0 1] {en}]} {
	incr x
    }

    if {$x} {
	return 1
    } else {
	return 0
    }
}

proc GetEnvHome {} {
    global env

    # return current directory by default
    set home {}

    global tcl_platform
    switch $tcl_platform(platform) {
	unix {
	    if [info exists env(HOME)] {
		set home $env(HOME)
	    }
	}
	windows {
	    if {[info exists env(HOME)]} {
		set hh [file normalize [file nativename $env(HOME)]]
		if [file isdirectory $hh] {
		    set home $hh
		}
	    }
	    # this is just a backup, the above should always work
	    if {$home == {} &&
		[info exists env(HOMEDRIVE)] &&
		[info exists env(HOMEPATH)]} {
		set home "$env(HOMEDRIVE)$env(HOMEPATH)"
	    }
	}
    }

    # if there is a problem, just return current directory
    if {![file isdirectory $home]} {
	set home {.}
    }

    return $home
}

proc InitTempDir {} { 
    global ds9
    global env

    # check environment vars first
    #   windows is very picky as to file name format 
    if [info exists env(TEMP)] {
	set ds9(tmpdir) [file normalize [file nativename $env(TEMP)]]
    } elseif [info exists env(TMP)] {
	set ds9(tmpdir) [file normalize [file nativename $env(TMP)]]
    }

    # nothing so far, go with defaults
    if {$ds9(tmpdir) == {}} {
	global tcl_platform
	switch $tcl_platform(platform) {
	    unix {set ds9(tmpdir) "/tmp"}
	    windows {set ds9(tmpdir) "C:/WINDOWS/Temp"}
	}
    }

    #   see if it is valid, else current directory
    if {![file isdirectory $ds9(tmpdir)]} {
	set ds9(tmpdir) {.}
    }
}

proc tmpnam {base ext} {
    global ds9

    for {set ii 0} {$ii<10} {incr ii} {
	set fn "$ds9(tmpdir)/$base[clock clicks]$ext"
	if {![file exists $fn]} {
	    return $fn
	}
    }

    # give up
    return $ds9(tmpdir)/$base$ext
}

# which compiler do we use for filtering?
proc InitFilterCompiler {} {
    global ds9
    global env
    global tcl_platform
    global argv0

    # if the user did not explicitly specify one ...
    if {![info exists env(FILTER_CC)]} {
	switch -- $tcl_platform(os) {
	    Darwin {
		if {![file exists /usr/bin/gcc]} {
		    # pcc is hardwired to be installed in /tmp
		    set pccroot "/tmp/pcc"
		    set pcc "$pccroot/bin/pcc"

		    # always install pcc at startup
		    # we don't want old versions of pcc around after upgrades
		    switch -- $tcl_platform(machine) {
			{Power Macintosh} {set machine ppc}
			i386 -
			default {set machine i386}
		    }
		    switch [lindex [split $tcl_platform(osVersion) {.}] 0] {
			8 {set os tiger}
			9 {set os leopard}
			10 -
			11 -
			default {set os snowleopard}
		    }
		    set tar "pcc-$machine-$os.tar.gz"

		    if [file readable "$ds9(root)/$tar"] {
			catch {
			    zvfs::filecopy "$ds9(root)/$tar" "/tmp/$tar"
			    exec tar xfPz /tmp/$tar -C /tmp
			    exec rm -f /tmp/$tar
			}
		    }

		    if {[file exists $pcc]} {
			set env(FILTER_CC) $pcc
			set env(FILTER_CFLAGS) "-isystem $pccroot/lib/pcc"
			set env(PATH) "$pccroot/bin:$env(PATH)"
		    }
		}
	    }

	    "Windows NT" {
		set tcc [file join [file dirname $argv0] tcc/tcc.exe]
		if [file exists $tcc] {
		    set env(FILTER_CC) [file nativename [file attributes [file normalize $tcc] -shortname]]
		    set env(FILTER_TMPDIR) [file nativename [file attributes [file normalize $ds9(tmpdir)] -shortname]]
		}
	    }
	}
    }
}

proc ToYesNo {value} {
    if {$value == 1} {
	return "yes\n"
    } else {
	return "no\n"
    }
}

proc FromYesNo {value} {
    set v [string tolower $value]

    if {$v == "no" || $v == "false" || $v == "off" || $v == 0} {
	return 0
    } else {
	return 1
    }
}

proc ProcessRealizeDS9 {} {
    global ds9
    global current

    # this can really slow down scripts so use ds9(last)
    # to remember last update
    if {$ds9(last) != $current(frame)} {
	RealizeDS9
	set ds9(last) $current(frame)
    }
}

proc RealizeDS9 {} {
    # this has to come first, to realize the canvas
    global debug
    if {$debug(tcl,idletasks)} {
	puts stderr "RealizeDS9"
    }

    # update all frames
    global ds9
    foreach ff $ds9(frames) {
	$ff update now
    }

# idletasks fails for windows. we need to process all events to make
# sure all windows are realized
#    update idletasks
    update
}

proc Sex2H {str} {
    scan $str "%d:%d:%f" h m s
    return [expr $h+($m/60.)+($s/(60.*60.))]
}

proc Sex2Hs {str} {
    scan $str "%d %d %f" h m s
    return [expr $h+($m/60.)+($s/(60.*60.))]
}

proc Sex2D {str} {
    set sign 1
    set degree 0
    set min 0
    set sec 0
    scan $str "%d:%f:%f" degree min sec

    if {$degree != 0} {
	if {$degree < 0} {
	    set sign -1
	}
    } else {
	if {[string range $str 0 0] == {-}} {
	    set sign -1
	}
    }

    return [expr $sign * (abs($degree)+($min/60.)+($sec/(60.*60.)))]
}

proc PixelsToPoints {size} {
    if {$size < 0} {
	set size [expr int(abs($size)/[tk scaling]+.5)]
    }
    return $size
}

proc SetCursor {cursor} {
    global ds9
    global iis
    global current

    # if init phase, don't change cursor
    if {$ds9(init)} {
	return
    }

    # if iis cursor mode, don't change cursor
    if {$iis(state)} {
	return
    }

    if {($current(cursor) != $cursor)} {
	set current(cursor) $cursor
	if {$cursor != {}} {
	    $ds9(canvas) configure -cursor $cursor
	} else {
	    $ds9(canvas) configure -cursor {}
	}
    }
}

proc SetWatchCursor {} {
    global ds9
    global icursor

    # if init phase, don't change cursor
    if {$ds9(init)} {
	return
    }

    # don't change cursor/update
    if {!$ds9(idletasks)} {
	return
    }

    global debug
    if {$debug(tcl,watch)} {
	puts stderr "SetWatchCursor Start $icursor(count)"
    }

    if {$icursor(count) == 0} {
	set icursor(save) [$ds9(canvas) cget -cursor]
	$ds9(canvas) configure -cursor {}
	$ds9(main) configure -cursor watch

	global debug
	if {$debug(tcl,idletasks)} {
	    puts stderr "SetWatchCursor"
	}
	update idletasks
    }
    incr icursor(count)

    if {$debug(tcl,watch)} {
	puts stderr "SetWatchCursor End $icursor(count)"
    }
}

proc UnsetWatchCursor {} {
    global ds9
    global icursor

    # if init phase, don't change cursor
    if {$ds9(init)} {
	return
    }

    # don't change cursor/update
    if {!$ds9(idletasks)} {
	return
    }

    global debug
    if {$debug(tcl,watch)} {
	puts stderr "UnsetWatchCursor Start $icursor(count)"
    }

    if {$icursor(count)>0} {
	incr icursor(count) -1
    }

    if {$icursor(count) == 0} {
	$ds9(main) configure -cursor {}
	$ds9(canvas) configure -cursor $icursor(save)

	global debug
	if {$debug(tcl,idletasks)} {
	    puts stderr "UnsetWatchCursor"
	}
	update idletasks
    }    

    if {$debug(tcl,watch)} {
	puts stderr "UnsetWatchCursor End $icursor(count)"
    }
}

proc CursorTimer {} {
    global ds9
    global icursor

    switch -- $icursor(timer) {
	0 {
	    set icursor(timer,abort) 0
	    set icursor(timer) 0
	    set icursor(id) 0
	    $ds9(canvas) configure -cursor {}
	}
	1 {
	    $ds9(canvas) configure -cursor circle
	    set icursor(timer) 2
	    set icursor(id) [after 1000 CursorTimer]
	}
	2 {
	    $ds9(canvas) configure -cursor dot
	    set icursor(timer) 1
	    set icursor(id) [after 1000 CursorTimer]
	}
    }
}

proc AboutBox {} {
    global help
    global ds9
    global ed

    set w {.abt}

    set ed(ok) 0

    DialogCreate $w [msgcat::mc {About SAOImage DS9}] ed(ok)

    # Param
    set f [frame $w.param -background white]
    canvas $f.c -background white -height 485 -width 550
    pack $f.c -fill both -expand true
    
    # can't use -file for zvfs
    # set ed(sun) [image create photo -format gif -file $ds9(root)/doc/sun.gif]
    set ch [open $ds9(root)/sun.gif r]
    fconfigure $ch -translation binary -encoding binary
    set dd [read $ch]
    close $ch
    unset ch

    set ed(sun) [image create photo -format gif -data "$dd"]
    unset dd

    $f.c create image 0 0 -image $ed(sun) -anchor nw
    $f.c create text 120 22 -text $help(about) -anchor nw -width 400

    # Buttons
    set f [ttk::frame $w.buttons]
    ttk::button $f.ok -text [msgcat::mc {OK}] -command {set ed(ok) 1} \
	-default active 
    pack $f.ok -padx 2 -pady 2

    bind $w <Return> {set ed(ok) 1}

    # Fini
    ttk::separator $w.sep -orient horizontal
    pack $w.buttons $w.sep -side bottom -fill x
    pack $w.param -side top -fill both -expand true

    DialogCenter $w
    DialogWait $w ed(ok)
    DialogDismiss $w

    image delete $ed(sun)
    unset ed
}

proc QuitDS9 {} {
    global ds9

    # shutdown SAMP
    global samp
    if [info exists samp] {
	catch {SAMPDisconnect}
    }

    # close IIS ports
    catch {IISClose}

    # close out XPA
    global xpa
    if [info exists xpa] {
	catch {xpafree $xpa}
    }

    # close all HV windows, they may have tmp files
    global ihv
    foreach hh $ihv(windows) {
	if [winfo exists $hh] {
	    catch {HVDestroy $hh}
	}
    }

    focus {}
    exit
}

proc OpenSource {} {
    set filename [OpenFileDialog tclfbox]
    if {$filename != {}} {
	uplevel #0 "source \{$filename\}"
    }
}

proc OpenConsole {} {
    if {[winfo exists ".tkcon"]} {
	tkcon show
    } else {
	set ::tkcon::OPT(exec) {}
	tkcon::Init
    }
}

proc ToggleBindEvents {} {
    global ds9

    if {$ds9(freeze)} {
	set ds9(freeze) 0
	BindEventsCanvas
	BindEventsPanner
    } else {
	set ds9(freeze) 1
	UnBindEventsCanvas
	UnBindEventsPanner
    }
}

proc ChangeMode {} {
    global ds9
    global current

    bind $ds9(canvas) <Button-1> {}
    bind $ds9(canvas) <B1-Motion> {}
    bind $ds9(canvas) <ButtonRelease-1> {}

    foreach f $ds9(frames) {
	$f crosshair off
    }
    UpdateRegionMenu

    foreach f $ds9(frames) {
	$f marker catalog unselect all
	$f marker catalog unhighlite all
	$f marker unselect all
	$f marker unhighlite all
    }

    RefreshInfoBox $current(frame)
    PixelTableClearDialog
    ClearGraphData

    switch -- $current(mode) {
	none -
	pointer -
	catalog {SetCursor {}}
	crosshair {
	    foreach f $ds9(frames) {
		$f crosshair on
	    }
	    SetCursor crosshair
	}
	colorbar {SetCursor center_ptr}
	zoom {SetCursor sizing}
	pan {SetCursor fleur}
	rotate {SetCursor exchange}
	crop {SetCursor {}}
	examine {SetCursor target}
	imexam {}
    }
}

proc PrefsTheme {} {
    global ds9
    global pds9

    if {[lsearch [ttk::style theme names] $pds9(theme)] < 0} {
	set pds9(theme) native
    }
    switch $pds9(theme) {
	native {
	    switch $ds9(wm) {
		x11 {ttk::style theme use default}
		win32 {ttk::style theme use xpnative}
		aqua {}
	    }
	}
	default {ttk::style theme use $pds9(theme)}
    }

    # set bg for non ttk widgets
    set ds9(app,bg) [ttk::style lookup "." -background]

    option add {*Bbutton.Background} $ds9(app,bg)
    option add {*Radiobutton.Background} $ds9(app,bg)
    option add {*Checkbutton.Background} $ds9(app,bg)
    option add {*Text.Background} $ds9(app,bg)
    option add {*Listbox.Background} $ds9(app,bg)
    option add {*Scale.Background} $ds9(app,bg)
    option add {*Menu.background} $ds9(app,bg)
    option add {*Table.Background} $ds9(app,bg)
    option add {*Graph.Background} $ds9(app,bg)
    option add {*Barchart.Background} $ds9(app,bg)
}

proc PrefsDefaultFont {} {
    global ds9
    global pds9

    font configure TkDefaultFont -family $ds9($pds9(font)) \
	-size $pds9(font,size) -weight $pds9(font,weight) \
	-slant $pds9(font,slant)
    font configure TkMenuFont -family $ds9($pds9(font)) \
	-size $pds9(font,size) -weight $pds9(font,weight) \
	-slant $pds9(font,slant)
    font configure TkTextFont -family $ds9($pds9(font)) \
	-size $pds9(font,size) -weight $pds9(font,weight) \
	-slant $pds9(font,slant)

    UpdateScaleDialogFont
    UpdateGraphFont
}

proc PrefsResetDefaultFont {} {
    global pds9

    eval font configure TkDefaultFont [font actual DefaultFont]
    eval font configure TkMenuFont [font actual DefaultMenuFont]
    eval font configure TkTextFont [font actual DefaultTextFont]

    set pds9(font) helvetica
    set pds9(font,size) [PixelsToPoints [font configure TkDefaultFont -size]]
    set pds9(font,weight) [font configure TkDefaultFont -weight]
    set pds9(font,slant) [font configure TkDefaultFont -slant]

    FontMenuButtonCmd pds9 font {}
}

proc PrefsResetDefaultTextFont {} {
    global pds9

    set pds9(text,font) courier
    set pds9(text,font,size) [PixelsToPoints [font actual TkFixedFont -size]]
    set pds9(text,font,weight) [font actual TkFixedFont -weight]
    set pds9(text,font,slant) [font actual TkFixedFont -slant]

    FontMenuButtonCmd pds9 text,font {}
}

proc PrefsBgColor {} {
    global ds9
    global pds9

    foreach ff $ds9(frames) {
	$ff bg color $pds9(bg)
    }
}

proc PrefsNanColor {} {
    global ds9
    global pds9

    foreach ff $ds9(frames) {
	$ff nan color $pds9(nan)
    }
}

proc PrefsThreads {} {
    global ds9
    global pds9

    foreach ff $ds9(frames) {
	$ff threads $pds9(threads)
    }
    return true
}

proc DisplayLog {item} {
    SimpleTextDialog ftptxt [msgcat::mc {Message Log}] 80 40 append bottom $item
}

proc ParseURL {url varname} {
    upvar $varname r

    set r(scheme) {}
    set r(authority) {}
    set r(path) {}
    set r(query) {}
    set r(fragment) {}
    set exp {^(([^:/?#]+):)?(//([^/?#]*))?([^?#]*)(\?([^#]*))?(#(.*))?}

    if {![regexp -nocase $exp $url x a r(scheme) c r(authority) r(path) f r(query) h r(fragment)]} {
	return 0
    }

    # check for windows disk drives
    global tcl_platform
    switch $tcl_platform(platform) {
	unix {}
	windows {
	    switch -- $r(scheme) {
		{} -
		ftp -
		http -
		file {
		    if [regexp {/([A-Z]:)(/.*)} $r(path) a b c] {
			set r(path) "$b$c"
		    }
		}
		default {
		    set r(path) "$r(scheme):$r(path)"
		    set r(scheme) {}
		}
	    }
	}
    }

    return 1
}

proc BreakUp {str} {
    set r {}
    set l [string length $str]
    for {set i 0} {$i < $l} {incr i} {
	set c [string index $str $i]
	append r $c
	if {$c=="\}"} {
	    append r "\n"
	}
    }
    return $r
}

proc InPath {which} {
    global env
    global tcl_platform

    switch $tcl_platform(platform) {
	unix {
	    set target ${which}
	    set paths [split $env(PATH) :]
	}
	windows {
	    set target ${which}.exe
	    set paths [split $env(PATH) \;]
	}
    }

    foreach p $paths {
	if {[file executable [file join $p $target]]} {
	    return 1
	}
    }
    return 0
}

proc FTPLog {s msg state} {
    global debug

    if {$debug(tcl,ftp)} {
	DisplayLog "$s $msg $state\n"
    }
}

proc HTTPLog {token} {
    global debug

    if {$debug(tcl,http)} {
	upvar #0 $token t

	DisplayLog "url: $t(url)\n"
	DisplayLog "http: $t(http)\n"
	DisplayLog "type: $t(type)\n"
	DisplayLog "currentsize: $t(currentsize)\n"
	DisplayLog "totalsize: $t(totalsize)\n"
	DisplayLog "status: $t(status)\n"
	if [info exists t(error)] {
	    DisplayLog "error: $t(error)\n"
	}
	DisplayLog "meta: [BreakUp $t(meta)]\n"
    }
}

proc ConfigHTTP {} {
    global phttp

    # set the User-Agent
    http::config -useragent ds9

    # set the proxy if requested
    if {$phttp(proxy)} {
	http::config -proxyhost $phttp(proxy,host) -proxyport $phttp(proxy,port)
    }
}

proc ProxyHTTP {} {
    global phttp

    set auth {}
    if {$phttp(proxy) && $phttp(auth)} {
	set auth [list "Proxy-Authorization" [concat "Basic" [base64::encode $phttp(auth,user):$phttp(auth,passwd)]]]
    } 

    return $auth
}

proc ValidFits {filename} {
    if {$filename == {}} {
	return 0
    }

    # determine if its a fits file
    # first, strip the filename
    if {![regexp -nocase {(.*)(\[.*\])} $filename foo base ext]} {
	set base $filename
	set ext {}
    }

    set fd [open $base]
    if {$fd != {}} {
	set l [read $fd 9]
	close $fd
    }

    if {$l == "SIMPLE  ="} {
	return 1
    } else {
	return 0
    }
}

proc FixSpec {sysname skyname formatname defsys defsky defformat} {
    upvar $sysname sys
    upvar $skyname sky
    upvar $formatname format

    set rr 0

    switch -- $sys {
	image -
	physical -
	detector -
	amplifier -
	wcs -
	wcsa -
	wcsb -
	wcsc -
	wcsd -
	wcse -
	wcsf -
	wcsg -
	wcsh -
	wcsi -
	wcsj -
	wcsk -
	wcsl -
	wcsm -
	wcsn -
	wcso -
	wcsp -
	wcsq -
	wcsr -
	wcss -
	wcst -
	wcsu -
	wcsv -
	wcsw -
	wcsx -
	wcsy -
	wcsz {incr rr}

	fk4 -
	b1950 -
	fk5 -
	j2000 -
	icrs -
	galactic -
	ecliptic {
	    set format $sky
	    set sky $sys
	    set sys wcs
	}
	
	default {
	    set format $sky
	    set sky $sys
	    set sys $defsys
	}
    }

    switch -- $sky {
	fk4 -
	b1950 -
	fk5 -
	j2000 -
	icrs -
	galactic -
	ecliptic {incr rr}

	default {
	    set format $sky
	    set sky $defsky
	}
    }

    switch -- $format {
	degrees -
	arcmin -
	arcsec -
	sexagesimal {incr rr}

	default {
	    set format $defformat
	}
    }

    return $rr
}

proc FixSpecSystem {sysname defsys} {
    upvar $sysname sys

    set rr 0

    switch -- $sys {
	image -
	physical -
	detector -
	amplifier -
	wcs -
	wcsa -
	wcsb -
	wcsc -
	wcsd -
	wcse -
	wcsf -
	wcsg -
	wcsh -
	wcsi -
	wcsj -
	wcsk -
	wcsl -
	wcsm -
	wcsn -
	wcso -
	wcsp -
	wcsq -
	wcsr -
	wcss -
	wcst -
	wcsu -
	wcsv -
	wcsw -
	wcsx -
	wcsy -
	wcsz {incr rr}
	default {
	    set sys $defsys
	}
    }

    return $rr
}

proc DS9Backup {ch which} {
    global pds9

    puts $ch "$which bg color $pds9(bg)"
    puts $ch "$which nan color $pds9(nan)"
}

# Process Cmds

proc ProcessPrefsCmd {varname iname} {
    upvar $varname var
    upvar $iname i

    global pds9

    switch -- [string tolower [lindex $var $i]] {
	clear {ClearPrefs}
	bgcolor {
	    # backward compatibility
	    incr i
	    set pds9(bg) [lindex $var $i]
	    PrefsBgColor
	}
	nancolor {
	    # backward compatibility
	    incr i
	    set pds9(nan) [lindex $var $i]
	    PrefsNanColor
	}
	threads {
	    # backward compatibility
	    incr i
	    set pds9(threads) [lindex $var $i]
	    PrefsThreads
	}
    }
}

proc ProcessSendPrefsCmd {proc id param} {
    global pds9

    # backward compatibility
    switch -- [string tolower [lindex $param 0]] {
	bgcolor {$proc $id "$pds9(bg)\n"}
	nancolor {$proc $id "$pds9(nan)\n"}
	threads {$proc $id "$pds9(threads)\n"}
    }
}

proc ProcessBgCmd {varname iname} {
    upvar $varname var
    upvar $iname i

    global pds9
    set pds9(bg) [lindex $var $i]
    PrefsBgColor
}

proc ProcessSendBgCmd {proc id param} {
    global pds9

    $proc $id "$pds9(bg)\n"
}

proc ProcessNanCmd {varname iname} {
    upvar $varname var
    upvar $iname i

    global pds9
    set pds9(nan) [lindex $var $i]
    PrefsNanColor
}

proc ProcessSendNanCmd {proc id param} {
    global pds9

    $proc $id "$pds9(nan)\n"
}

proc ProcessThreadsCmd {varname iname} {
    upvar $varname var
    upvar $iname i

    global pds9
    set pds9(threads) [lindex $var $i]
    PrefsThreads
}

proc ProcessSendThreadsCmd {proc id param} {
    global pds9

    $proc $id "$pds9(threads)\n"
}

proc ProcessCDCmd {varname iname} {
    upvar $varname var
    upvar $iname i

    cd [lindex $var $i]
}

proc ProcessSendCDCmd {proc id param} {
    $proc $id "[pwd]\n"
}

proc ProcessConsoleCmd {varname iname} {
    upvar $varname var
    upvar $iname i

    OpenConsole

    # ignore error message about ActiveTcl
    global ds9
    InitError $ds9(msg,src)
}

proc ProcessCursorCmd {varname iname} {
    upvar $varname var
    upvar $iname i

    global current

    if {$current(frame) != {}} {
	set x [lindex $var $i]
	incr i
	set y [lindex $var $i]

	switch -- $current(mode) {
	    none {$current(frame) warp $x $y}
	    pointer {MarkerArrowKey $current(frame) $x $y}
	    catalog {MarkerArrowKey $current(frame) $x $y}
	    crosshair {ArrowKeyCrosshair $current(frame) $x $y}
	    colorbar {}
	    pan {Pan $x $y canvas}
	    zoom -
	    rotate -
	    crop -
	    examine -
	    imexam {}
	}
    }
}

proc ProcessSendDataCmd {proc id param sock fn} {
    global cube
    global blink
    global current

    if {$current(frame) != {}} {
	set sys [lindex $param 0]
	set sky [lindex $param 1]
	set x [lindex $param 2]
	set y [lindex $param 3]
	set w [lindex $param 4]
	set h [lindex $param 5]
	set strip [lindex $param 6]
	switch -- $sys {
	    image -
	    physical -
	    detector -
	    amplifier {
		set strip $h
		set h $w
		set w $y
		set y $x
		set x $sky
		set sky fk5
	    }

	    fk4 -
	    b1950 -
	    fk5 -
	    j2000 -
	    icrs -
	    galactic -
	    ecliptic {
		set strip $h
		set h $w
		set w $y
		set y $x
		set x $sky
		set sky $sys
		set sys wcs
	    }
	}
	set strip [FromYesNo $strip]

	$current(frame) get data $sys $sky $x $y $w $h rr
	set ss {}
	foreach ii [array names rr] {
	    if {$strip} {
		append ss "$rr($ii)\n"
	    } else {
		append ss "$ii = $rr($ii)\n"
	    }
	}
	ProcessSend $proc $id $sock $fn {.dat} $ss
    }
}

proc ProcessIconifyCmd {varname iname} {
    upvar $varname var
    upvar $iname i

    global ds9

    switch -- [string tolower [lindex $var $i]] {
	yes -
	true -
	on -
	1 {wm iconify $ds9(top)}

	no -
	false -
	off -
	0 {wm deiconify $ds9(top)}

	default {
	    wm iconify $ds9(top)
	    incr i -1
	}
    }
}

proc ProcessSendIconifyCmd {proc id param} {
    global ds9
    if {[wm state $ds9(top)] == "normal"} {
	$proc $id "no\n"
    } else {
	$proc $id "yes\n"
    }
}

proc ProcessLowerCmd {varname iname} {
    upvar $varname var
    upvar $iname i

    global ds9
    lower $ds9(top)
}

proc ProcessModeCmd {varname iname} {
    upvar $varname var
    upvar $iname i

    global current

    set current(mode) [string tolower [lindex $var $i]]
    ChangeMode
}

proc ProcessQuitCmd {varname iname} {
    upvar $varname var
    upvar $iname i

    QuitDS9
}

proc ProcessSendModeCmd {proc id param} {
    global current

    $proc $id "$current(mode)\n"
}

proc ProcessRaiseCmd {varname iname} {
    upvar $varname var
    upvar $iname i

    global ds9
    raise $ds9(top)
}

proc ProcessSleepCmd {varname iname} {
    upvar $varname var
    upvar $iname i

    # yes, we need this
    UpdateDS9
    RealizeDS9

    set sec 1
    if {[lindex $var $i] != {} && [string range [lindex $var $i] 0 0] != {-}} {
	set sec [lindex $var $i]
    } else {
	incr i -1
    }
    after [expr int($sec*1000)]
}

proc ProcessSourceCmd {varname iname} {
    upvar $varname var
    upvar $iname i

    # we need to be realized
    # you never know what someone will try to do
    ProcessRealizeDS9

    set fn [lindex $var $i]
    uplevel #0 "source $fn"
}

proc ProcessTclCmd {varname iname buf fn} {
    upvar $varname var
    upvar $iname i

    global pds9

    if {!$pds9(tcl)} {
	Error [msgcat::mc {Executing TCL code is not enabled}]
	return
    }

    if {$buf != {}} {
	uplevel #0 $buf
    } elseif {$fn != {}} {
	if {[file exists $fn]} {
	    set ch [open $fn r]
	    set cmd [read $ch]
	    close $ch
	    uplevel #0 $cmd
	}
    } elseif {[lindex $var $i] != {}} {
	# special case
	uplevel #0 $var
    }
}

proc ProcessThemeCmd {varname iname} {
    upvar $varname var
    upvar $iname i

    global pds9

    set pds9(theme) [string tolower [lindex $var $i]]
    PrefsTheme
}

proc ProcessSendThemeCmd {proc id param} {
    global pds9
    $proc $id "$pds9(theme)\n"
}

proc ProcessSendVersionCmd {proc id param} {
    global ds9
    $proc $id "$ds9(title) [lindex $ds9(version) 0]\n"
}

proc XMLQuote {val} {
    return [string map {& &amp; < &lt; > &gt; \' &apos; \" &quot;} $val]
}

proc XMLUnQuote {val} {
    return [string map {&amp; & &lt; < &gt; > &apos; \' &quot; \"} $val]
}